X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/68c45bf06516ed4650eb7f9f617742d84750600a..44dc78e04abbd8fe6aa72c4a115f67ef907f35ab:/src/process.c diff --git a/src/process.c b/src/process.c index 144e69af7c..3d0a84d4c7 100644 --- a/src/process.c +++ b/src/process.c @@ -1,5 +1,5 @@ /* Asynchronous subprocess control for GNU Emacs. - Copyright (C) 1985, 86, 87, 88, 93, 94, 95, 96, 98, 1999 + Copyright (C) 1985, 86, 87, 88, 93, 94, 95, 96, 98, 1999, 2001 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -20,8 +20,8 @@ the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ +#define _GNU_SOURCE /* to get strsignal declared with glibc 2 */ #include - #include /* This file is split into two parts by the following preprocessor @@ -44,7 +44,7 @@ Boston, MA 02111-1307, USA. */ #include #endif -#ifdef WINDOWSNT +#if defined(WINDOWSNT) || defined(UNIX98_PTYS) #include #include #endif /* not WINDOWSNT */ @@ -59,7 +59,7 @@ Boston, MA 02111-1307, USA. */ #endif /* NEED_NET_ERRNO_H */ #endif /* HAVE_SOCKETS */ -/* TERM is a poor-man's SLIP, used on Linux. */ +/* TERM is a poor-man's SLIP, used on GNU/Linux. */ #ifdef TERM #include #endif @@ -104,12 +104,12 @@ Boston, MA 02111-1307, USA. */ #include "termhooks.h" #include "termopts.h" #include "commands.h" +#include "keyboard.h" #include "frame.h" #include "blockinput.h" -#include "keyboard.h" #include "dispextern.h" - -#define max(a, b) ((a) > (b) ? (a) : (b)) +#include "composite.h" +#include "atimer.h" Lisp_Object Qprocessp; Lisp_Object Qrun, Qstop, Qsignal, Qopen, Qclosed; @@ -145,8 +145,9 @@ Lisp_Object Qlast_nonmenu_event; extern void set_waiting_for_input P_ ((EMACS_TIME *)); +#ifndef USE_CRT_DLL extern int errno; -extern char *strerror (); +#endif #ifdef VMS extern char *sys_errlist[]; #endif @@ -155,50 +156,6 @@ extern char *sys_errlist[]; extern int h_errno; #endif -#ifndef HAVE_STRSIGNAL -#ifndef SYS_SIGLIST_DECLARED -#ifndef VMS -#ifndef BSD4_1 -#ifndef WINDOWSNT -#ifndef LINUX -extern char *sys_siglist[]; -#endif /* not LINUX */ -#else /* BSD4_1 */ -char *sys_siglist[] = - { - "bum signal!!", - "hangup", - "interrupt", - "quit", - "illegal instruction", - "trace trap", - "iot instruction", - "emt instruction", - "floating point exception", - "kill", - "bus error", - "segmentation violation", - "bad argument to system call", - "write on a pipe with no one to read it", - "alarm clock", - "software termination signal from kill", - "status signal", - "sendable stop signal not from tty", - "stop signal from tty", - "continue a stopped process", - "child status has changed", - "background read attempted from control tty", - "background write attempted from control tty", - "input record available at control tty", - "exceeded CPU time limit", - "exceeded file size limit" - }; -#endif /* not WINDOWSNT */ -#endif -#endif /* VMS */ -#endif /* ! SYS_SIGLIST_DECLARED */ -#endif /* ! HAVE_STRSIGNAL */ - /* t means use pty, nil means use a pipe, maybe other values to come. */ static Lisp_Object Vprocess_connection_type; @@ -360,7 +317,7 @@ status_message (status) if (EQ (symbol, Qsignal) || EQ (symbol, Qstop)) { char *signame; - synchronize_messages_locale (); + synchronize_system_messages_locale (); signame = strsignal (code); if (signame == 0) signame = "unknown"; @@ -475,17 +432,12 @@ Lisp_Object make_process (name) Lisp_Object name; { - struct Lisp_Vector *vec; register Lisp_Object val, tem, name1; register struct Lisp_Process *p; char suffix[10]; register int i; - vec = allocate_vectorlike ((EMACS_INT) VECSIZE (struct Lisp_Process)); - for (i = 0; i < VECSIZE (struct Lisp_Process); i++) - vec->contents[i] = Qnil; - vec->size = VECSIZE (struct Lisp_Process); - p = (struct Lisp_Process *)vec; + p = allocate_process (); XSETINT (p->infd, -1); XSETINT (p->outfd, -1); @@ -527,28 +479,28 @@ remove_process (proc) } DEFUN ("processp", Fprocessp, Sprocessp, 1, 1, 0, - "Return t if OBJECT is a process.") - (object) + doc: /* Return t if OBJECT is a process. */) + (object) Lisp_Object object; { return PROCESSP (object) ? Qt : Qnil; } DEFUN ("get-process", Fget_process, Sget_process, 1, 1, 0, - "Return the process named NAME, or nil if there is none.") - (name) + doc: /* Return the process named NAME, or nil if there is none. */) + (name) register Lisp_Object name; { if (PROCESSP (name)) return name; - CHECK_STRING (name, 0); + CHECK_STRING (name); return Fcdr (Fassoc (name, Vprocess_alist)); } DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0, - "Return the (or a) process associated with BUFFER.\n\ -BUFFER may be a buffer or the name of one.") - (buffer) + doc: /* Return the (or a) process associated with BUFFER. +BUFFER may be a buffer or the name of one. */) + (buffer) register Lisp_Object buffer; { register Lisp_Object buf, tail, proc; @@ -599,17 +551,17 @@ get_process (name) } else { - CHECK_PROCESS (obj, 0); + CHECK_PROCESS (obj); proc = obj; } return proc; } DEFUN ("delete-process", Fdelete_process, Sdelete_process, 1, 1, 0, - "Delete PROCESS: kill it and forget about it immediately.\n\ -PROCESS may be a process, a buffer, the name of a process or buffer, or\n\ -nil, indicating the current buffer's process.") - (process) + doc: /* Delete PROCESS: kill it and forget about it immediately. +PROCESS may be a process, a buffer, the name of a process or buffer, or +nil, indicating the current buffer's process. */) + (process) register Lisp_Object process; { process = get_process (process); @@ -634,18 +586,18 @@ nil, indicating the current buffer's process.") } DEFUN ("process-status", Fprocess_status, Sprocess_status, 1, 1, 0, - "Return the status of PROCESS.\n\ -The returned value is one of the following symbols:\n\ -run -- for a process that is running.\n\ -stop -- for a process stopped but continuable.\n\ -exit -- for a process that has exited.\n\ -signal -- for a process that has got a fatal signal.\n\ -open -- for a network stream connection that is open.\n\ -closed -- for a network stream connection that is closed.\n\ -nil -- if arg is a process name and no such process exists.\n\ -PROCESS may be a process, a buffer, the name of a process, or\n\ -nil, indicating the current buffer's process.") - (process) + doc: /* Return the status of PROCESS. +The returned value is one of the following symbols: +run -- for a process that is running. +stop -- for a process stopped but continuable. +exit -- for a process that has exited. +signal -- for a process that has got a fatal signal. +open -- for a network stream connection that is open. +closed -- for a network stream connection that is closed. +nil -- if arg is a process name and no such process exists. +PROCESS may be a process, a buffer, the name of a process, or +nil, indicating the current buffer's process. */) + (process) register Lisp_Object process; { register struct Lisp_Process *p; @@ -677,12 +629,12 @@ nil, indicating the current buffer's process.") DEFUN ("process-exit-status", Fprocess_exit_status, Sprocess_exit_status, 1, 1, 0, - "Return the exit status of PROCESS or the signal number that killed it.\n\ -If PROCESS has not yet exited or died, return 0.") - (process) + doc: /* Return the exit status of PROCESS or the signal number that killed it. +If PROCESS has not yet exited or died, return 0. */) + (process) register Lisp_Object process; { - CHECK_PROCESS (process, 0); + CHECK_PROCESS (process); if (!NILP (XPROCESS (process)->raw_status_low)) update_status (XPROCESS (process)); if (CONSP (XPROCESS (process)->status)) @@ -691,211 +643,229 @@ If PROCESS has not yet exited or died, return 0.") } DEFUN ("process-id", Fprocess_id, Sprocess_id, 1, 1, 0, - "Return the process id of PROCESS.\n\ -This is the pid of the Unix process which PROCESS uses or talks to.\n\ -For a network connection, this value is nil.") - (process) + doc: /* Return the process id of PROCESS. +This is the pid of the Unix process which PROCESS uses or talks to. +For a network connection, this value is nil. */) + (process) register Lisp_Object process; { - CHECK_PROCESS (process, 0); + CHECK_PROCESS (process); return XPROCESS (process)->pid; } DEFUN ("process-name", Fprocess_name, Sprocess_name, 1, 1, 0, - "Return the name of PROCESS, as a string.\n\ -This is the name of the program invoked in PROCESS,\n\ -possibly modified to make it unique among process names.") - (process) + doc: /* Return the name of PROCESS, as a string. +This is the name of the program invoked in PROCESS, +possibly modified to make it unique among process names. */) + (process) register Lisp_Object process; { - CHECK_PROCESS (process, 0); + CHECK_PROCESS (process); return XPROCESS (process)->name; } DEFUN ("process-command", Fprocess_command, Sprocess_command, 1, 1, 0, - "Return the command that was executed to start PROCESS.\n\ -This is a list of strings, the first string being the program executed\n\ -and the rest of the strings being the arguments given to it.\n\ -For a non-child channel, this is nil.") - (process) + doc: /* Return the command that was executed to start PROCESS. +This is a list of strings, the first string being the program executed +and the rest of the strings being the arguments given to it. +For a non-child channel, this is nil. */) + (process) register Lisp_Object process; { - CHECK_PROCESS (process, 0); + CHECK_PROCESS (process); return XPROCESS (process)->command; } DEFUN ("process-tty-name", Fprocess_tty_name, Sprocess_tty_name, 1, 1, 0, - "Return the name of the terminal PROCESS uses, or nil if none.\n\ -This is the terminal that the process itself reads and writes on,\n\ -not the name of the pty that Emacs uses to talk with that terminal.") - (process) + doc: /* Return the name of the terminal PROCESS uses, or nil if none. +This is the terminal that the process itself reads and writes on, +not the name of the pty that Emacs uses to talk with that terminal. */) + (process) register Lisp_Object process; { - CHECK_PROCESS (process, 0); + CHECK_PROCESS (process); return XPROCESS (process)->tty_name; } DEFUN ("set-process-buffer", Fset_process_buffer, Sset_process_buffer, - 2, 2, 0, - "Set buffer associated with PROCESS to BUFFER (a buffer, or nil).") - (process, buffer) + 2, 2, 0, + doc: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil). */) + (process, buffer) register Lisp_Object process, buffer; { - CHECK_PROCESS (process, 0); + CHECK_PROCESS (process); if (!NILP (buffer)) - CHECK_BUFFER (buffer, 1); + CHECK_BUFFER (buffer); XPROCESS (process)->buffer = buffer; return buffer; } DEFUN ("process-buffer", Fprocess_buffer, Sprocess_buffer, - 1, 1, 0, - "Return the buffer PROCESS is associated with.\n\ -Output from PROCESS is inserted in this buffer unless PROCESS has a filter.") - (process) + 1, 1, 0, + doc: /* Return the buffer PROCESS is associated with. +Output from PROCESS is inserted in this buffer unless PROCESS has a filter. */) + (process) register Lisp_Object process; { - CHECK_PROCESS (process, 0); + CHECK_PROCESS (process); return XPROCESS (process)->buffer; } DEFUN ("process-mark", Fprocess_mark, Sprocess_mark, - 1, 1, 0, - "Return the marker for the end of the last output from PROCESS.") - (process) + 1, 1, 0, + doc: /* Return the marker for the end of the last output from PROCESS. */) + (process) register Lisp_Object process; { - CHECK_PROCESS (process, 0); + CHECK_PROCESS (process); return XPROCESS (process)->mark; } DEFUN ("set-process-filter", Fset_process_filter, Sset_process_filter, - 2, 2, 0, - "Give PROCESS the filter function FILTER; nil means no filter.\n\ -t means stop accepting output from the process.\n\ -When a process has a filter, each time it does output\n\ -the entire string of output is passed to the filter.\n\ -The filter gets two arguments: the process and the string of output.\n\ -If the process has a filter, its buffer is not used for output.") - (process, filter) + 2, 2, 0, + doc: /* Give PROCESS the filter function FILTER; nil means no filter. +t means stop accepting output from the process. +When a process has a filter, each time it does output +the entire string of output is passed to the filter. +The filter gets two arguments: the process and the string of output. +If the process has a filter, its buffer is not used for output. */) + (process, filter) register Lisp_Object process, filter; { - CHECK_PROCESS (process, 0); - if (EQ (filter, Qt)) - { - FD_CLR (XINT (XPROCESS (process)->infd), &input_wait_mask); - FD_CLR (XINT (XPROCESS (process)->infd), &non_keyboard_wait_mask); - } - else if (EQ (XPROCESS (process)->filter, Qt)) + struct Lisp_Process *p; + + CHECK_PROCESS (process); + p = XPROCESS (process); + + /* Don't signal an error if the process' input file descriptor + is closed. This could make debugging Lisp more difficult, + for example when doing something like + + (setq process (start-process ...)) + (debug) + (set-process-filter process ...) */ + + if (XINT (p->infd) >= 0) { - FD_SET (XINT (XPROCESS (process)->infd), &input_wait_mask); - FD_SET (XINT (XPROCESS (process)->infd), &non_keyboard_wait_mask); + if (EQ (filter, Qt)) + { + FD_CLR (XINT (p->infd), &input_wait_mask); + FD_CLR (XINT (p->infd), &non_keyboard_wait_mask); + } + else if (EQ (XPROCESS (process)->filter, Qt)) + { + FD_SET (XINT (p->infd), &input_wait_mask); + FD_SET (XINT (p->infd), &non_keyboard_wait_mask); + } } - XPROCESS (process)->filter = filter; + + p->filter = filter; return filter; } DEFUN ("process-filter", Fprocess_filter, Sprocess_filter, - 1, 1, 0, - "Returns the filter function of PROCESS; nil if none.\n\ -See `set-process-filter' for more info on filter functions.") - (process) + 1, 1, 0, + doc: /* Returns the filter function of PROCESS; nil if none. +See `set-process-filter' for more info on filter functions. */) + (process) register Lisp_Object process; { - CHECK_PROCESS (process, 0); + CHECK_PROCESS (process); return XPROCESS (process)->filter; } DEFUN ("set-process-sentinel", Fset_process_sentinel, Sset_process_sentinel, - 2, 2, 0, - "Give PROCESS the sentinel SENTINEL; nil for none.\n\ -The sentinel is called as a function when the process changes state.\n\ -It gets two arguments: the process, and a string describing the change.") - (process, sentinel) + 2, 2, 0, + doc: /* Give PROCESS the sentinel SENTINEL; nil for none. +The sentinel is called as a function when the process changes state. +It gets two arguments: the process, and a string describing the change. */) + (process, sentinel) register Lisp_Object process, sentinel; { - CHECK_PROCESS (process, 0); + CHECK_PROCESS (process); XPROCESS (process)->sentinel = sentinel; return sentinel; } DEFUN ("process-sentinel", Fprocess_sentinel, Sprocess_sentinel, - 1, 1, 0, - "Return the sentinel of PROCESS; nil if none.\n\ -See `set-process-sentinel' for more info on sentinels.") - (process) + 1, 1, 0, + doc: /* Return the sentinel of PROCESS; nil if none. +See `set-process-sentinel' for more info on sentinels. */) + (process) register Lisp_Object process; { - CHECK_PROCESS (process, 0); + CHECK_PROCESS (process); return XPROCESS (process)->sentinel; } DEFUN ("set-process-window-size", Fset_process_window_size, - Sset_process_window_size, 3, 3, 0, - "Tell PROCESS that it has logical window size HEIGHT and WIDTH.") - (process, height, width) + Sset_process_window_size, 3, 3, 0, + doc: /* Tell PROCESS that it has logical window size HEIGHT and WIDTH. */) + (process, height, width) register Lisp_Object process, height, width; { - CHECK_PROCESS (process, 0); - CHECK_NATNUM (height, 0); - CHECK_NATNUM (width, 0); - if (set_window_size (XINT (XPROCESS (process)->infd), - XINT (height), XINT (width)) <= 0) + CHECK_PROCESS (process); + CHECK_NATNUM (height); + CHECK_NATNUM (width); + + if (XINT (XPROCESS (process)->infd) < 0 + || set_window_size (XINT (XPROCESS (process)->infd), + XINT (height), XINT (width)) <= 0) return Qnil; else return Qt; } DEFUN ("set-process-inherit-coding-system-flag", - Fset_process_inherit_coding_system_flag, - Sset_process_inherit_coding_system_flag, 2, 2, 0, - "Determine whether buffer of PROCESS will inherit coding-system.\n\ -If the second argument FLAG is non-nil, then the variable\n\ -`buffer-file-coding-system' of the buffer associated with PROCESS\n\ -will be bound to the value of the coding system used to decode\n\ -the process output.\n\ -\n\ -This is useful when the coding system specified for the process buffer\n\ -leaves either the character code conversion or the end-of-line conversion\n\ -unspecified, or if the coding system used to decode the process output\n\ -is more appropriate for saving the process buffer.\n\ -\n\ -Binding the variable `inherit-process-coding-system' to non-nil before\n\ -starting the process is an alternative way of setting the inherit flag\n\ -for the process which will run.") - (process, flag) + Fset_process_inherit_coding_system_flag, + Sset_process_inherit_coding_system_flag, 2, 2, 0, + doc: /* Determine whether buffer of PROCESS will inherit coding-system. +If the second argument FLAG is non-nil, then the variable +`buffer-file-coding-system' of the buffer associated with PROCESS +will be bound to the value of the coding system used to decode +the process output. + +This is useful when the coding system specified for the process buffer +leaves either the character code conversion or the end-of-line conversion +unspecified, or if the coding system used to decode the process output +is more appropriate for saving the process buffer. + +Binding the variable `inherit-process-coding-system' to non-nil before +starting the process is an alternative way of setting the inherit flag +for the process which will run. */) + (process, flag) register Lisp_Object process, flag; { - CHECK_PROCESS (process, 0); + CHECK_PROCESS (process); XPROCESS (process)->inherit_coding_system_flag = flag; return flag; } DEFUN ("process-inherit-coding-system-flag", - Fprocess_inherit_coding_system_flag, Sprocess_inherit_coding_system_flag, - 1, 1, 0, - "Return the value of inherit-coding-system flag for PROCESS.\n\ -If this flag is t, `buffer-file-coding-system' of the buffer\n\ -associated with PROCESS will inherit the coding system used to decode\n\ -the process output.") - (process) + Fprocess_inherit_coding_system_flag, Sprocess_inherit_coding_system_flag, + 1, 1, 0, + doc: /* Return the value of inherit-coding-system flag for PROCESS. +If this flag is t, `buffer-file-coding-system' of the buffer +associated with PROCESS will inherit the coding system used to decode +the process output. */) + (process) register Lisp_Object process; { - CHECK_PROCESS (process, 0); + CHECK_PROCESS (process); return XPROCESS (process)->inherit_coding_system_flag; } DEFUN ("process-kill-without-query", Fprocess_kill_without_query, - Sprocess_kill_without_query, 1, 2, 0, - "Say no query needed if PROCESS is running when Emacs is exited.\n\ -Optional second argument if non-nil says to require a query.\n\ -Value is t if a query was formerly required.") - (process, value) + Sprocess_kill_without_query, 1, 2, 0, + doc: /* Say no query needed if PROCESS is running when Emacs is exited. +Optional second argument if non-nil says to require a query. +Value is t if a query was formerly required. */) + (process, value) register Lisp_Object process, value; { Lisp_Object tem; - CHECK_PROCESS (process, 0); + CHECK_PROCESS (process); tem = XPROCESS (process)->kill_without_query; XPROCESS (process)->kill_without_query = Fnull (value); @@ -903,23 +873,23 @@ Value is t if a query was formerly required.") } DEFUN ("process-contact", Fprocess_contact, Sprocess_contact, - 1, 1, 0, - "Return the contact info of PROCESS; t for a real child.\n\ -For a net connection, the value is a cons cell of the form (HOST SERVICE).") - (process) + 1, 1, 0, + doc: /* Return the contact info of PROCESS; t for a real child. +For a net connection, the value is a cons cell of the form (HOST SERVICE). */) + (process) register Lisp_Object process; { - CHECK_PROCESS (process, 0); + CHECK_PROCESS (process); return XPROCESS (process)->childp; } #if 0 /* Turned off because we don't currently record this info in the process. Perhaps add it. */ DEFUN ("process-connection", Fprocess_connection, Sprocess_connection, 1, 1, 0, - "Return the connection type of PROCESS.\n\ -The value is nil for a pipe, t or `pty' for a pty, or `stream' for\n\ -a socket connection.") - (process) + doc: /* Return the connection type of PROCESS. +The value is nil for a pipe, t or `pty' for a pty, or `stream' for +a socket connection. */) + (process) Lisp_Object process; { return XPROCESS (process)->type; @@ -1043,10 +1013,10 @@ Proc Status Buffer Tty Command\n\ } DEFUN ("list-processes", Flist_processes, Slist_processes, 0, 0, "", - "Display a list of all processes.\n\ -Any process listed as exited or signaled is actually eliminated\n\ -after the listing is made.") - () + doc: /* Display a list of all processes. +Any process listed as exited or signaled is actually eliminated +after the listing is made. */) + () { internal_with_output_to_temp_buffer ("*Process List*", list_processes_1, Qnil); @@ -1054,8 +1024,8 @@ after the listing is made.") } DEFUN ("process-list", Fprocess_list, Sprocess_list, 0, 0, 0, - "Return a list of all processes.") - () + doc: /* Return a list of all processes. */) + () { return Fmapcar (Qcdr, Vprocess_alist); } @@ -1065,17 +1035,17 @@ DEFUN ("process-list", Fprocess_list, Sprocess_list, 0, 0, 0, static Lisp_Object start_process_unwind (); DEFUN ("start-process", Fstart_process, Sstart_process, 3, MANY, 0, - "Start a program in a subprocess. Return the process object for it.\n\ -Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS\n\ -NAME is name for process. It is modified if necessary to make it unique.\n\ -BUFFER is the buffer or (buffer-name) to associate with the process.\n\ - Process output goes at end of that buffer, unless you specify\n\ - an output stream or filter function to handle the output.\n\ - BUFFER may be also nil, meaning that this process is not associated\n\ - with any buffer.\n\ -Third arg is program file name. It is searched for in PATH.\n\ -Remaining arguments are strings to give program as arguments.") - (nargs, args) + doc: /* Start a program in a subprocess. Return the process object for it. +NAME is name for process. It is modified if necessary to make it unique. +BUFFER is the buffer or (buffer-name) to associate with the process. + Process output goes at end of that buffer, unless you specify + an output stream or filter function to handle the output. + BUFFER may be also nil, meaning that this process is not associated + with any buffer. +Third arg is program file name. It is searched for in PATH. +Remaining arguments are strings to give program as arguments. +usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */) + (nargs, args) int nargs; register Lisp_Object *args; { @@ -1120,68 +1090,11 @@ Remaining arguments are strings to give program as arguments.") } name = args[0]; - CHECK_STRING (name, 0); + CHECK_STRING (name); program = args[2]; - CHECK_STRING (program, 2); - -#ifdef VMS - /* Make a one member argv with all args concatenated - together separated by a blank. */ - len = STRING_BYTES (XSTRING (program)) + 2; - for (i = 3; i < nargs; i++) - { - tem = args[i]; - CHECK_STRING (tem, i); - len += STRING_BYTES (XSTRING (tem)) + 1; /* count the blank */ - } - new_argv = (unsigned char *) alloca (len); - strcpy (new_argv, XSTRING (program)->data); - for (i = 3; i < nargs; i++) - { - tem = args[i]; - CHECK_STRING (tem, i); - strcat (new_argv, " "); - strcat (new_argv, XSTRING (tem)->data); - } - /* Need to add code here to check for program existence on VMS */ - -#else /* not VMS */ - new_argv = (unsigned char **) alloca ((nargs - 1) * sizeof (char *)); - - /* If program file name is not absolute, search our path for it */ - if (!IS_DIRECTORY_SEP (XSTRING (program)->data[0]) - && !(XSTRING (program)->size > 1 - && IS_DEVICE_SEP (XSTRING (program)->data[1]))) - { - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; - - tem = Qnil; - GCPRO4 (name, program, buffer, current_dir); - openp (Vexec_path, program, EXEC_SUFFIXES, &tem, 1); - UNGCPRO; - if (NILP (tem)) - report_file_error ("Searching for program", Fcons (program, Qnil)); - tem = Fexpand_file_name (tem, Qnil); - new_argv[0] = XSTRING (tem)->data; - } - else - { - if (!NILP (Ffile_directory_p (program))) - error ("Specified program for new process is a directory"); - - new_argv[0] = XSTRING (program)->data; - } - - for (i = 3; i < nargs; i++) - { - tem = args[i]; - CHECK_STRING (tem, i); - new_argv[i - 2] = XSTRING (tem)->data; - } - new_argv[i - 2] = 0; -#endif /* not VMS */ + CHECK_STRING (program); proc = make_process (name); /* If an error occurs and we can't start the process, we want to @@ -1211,7 +1124,7 @@ Remaining arguments are strings to give program as arguments.") /* Qt denotes we have not yet called Ffind_operation_coding_system. */ Lisp_Object coding_systems = Qt; Lisp_Object val, *args2; - struct gcpro gcpro1; + struct gcpro gcpro1, gcpro2; val = Vcoding_system_for_read; if (NILP (val)) @@ -1219,7 +1132,7 @@ Remaining arguments are strings to give program as arguments.") args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof *args2); args2[0] = Qstart_process; for (i = 0; i < nargs; i++) args2[i + 1] = args[i]; - GCPRO1 (proc); + GCPRO2 (proc, current_dir); coding_systems = Ffind_operation_coding_system (nargs + 1, args2); UNGCPRO; if (CONSP (coding_systems)) @@ -1237,7 +1150,7 @@ Remaining arguments are strings to give program as arguments.") args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof args2); args2[0] = Qstart_process; for (i = 0; i < nargs; i++) args2[i + 1] = args[i]; - GCPRO1 (proc); + GCPRO2 (proc, current_dir); coding_systems = Ffind_operation_coding_system (nargs + 1, args2); UNGCPRO; } @@ -1249,6 +1162,73 @@ Remaining arguments are strings to give program as arguments.") XPROCESS (proc)->encode_coding_system = val; } +#ifdef VMS + /* Make a one member argv with all args concatenated + together separated by a blank. */ + len = STRING_BYTES (XSTRING (program)) + 2; + for (i = 3; i < nargs; i++) + { + tem = args[i]; + CHECK_STRING (tem); + len += STRING_BYTES (XSTRING (tem)) + 1; /* count the blank */ + } + new_argv = (unsigned char *) alloca (len); + strcpy (new_argv, XSTRING (program)->data); + for (i = 3; i < nargs; i++) + { + tem = args[i]; + CHECK_STRING (tem); + strcat (new_argv, " "); + strcat (new_argv, XSTRING (tem)->data); + } + /* Need to add code here to check for program existence on VMS */ + +#else /* not VMS */ + new_argv = (unsigned char **) alloca ((nargs - 1) * sizeof (char *)); + + /* If program file name is not absolute, search our path for it */ + if (!IS_DIRECTORY_SEP (XSTRING (program)->data[0]) + && !(XSTRING (program)->size > 1 + && IS_DEVICE_SEP (XSTRING (program)->data[1]))) + { + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; + + tem = Qnil; + GCPRO4 (name, program, buffer, current_dir); + openp (Vexec_path, program, Vexec_suffixes, &tem, 1); + UNGCPRO; + if (NILP (tem)) + report_file_error ("Searching for program", Fcons (program, Qnil)); + tem = Fexpand_file_name (tem, Qnil); + tem = ENCODE_FILE (tem); + new_argv[0] = XSTRING (tem)->data; + } + else + { + if (!NILP (Ffile_directory_p (program))) + error ("Specified program for new process is a directory"); + + tem = ENCODE_FILE (program); + new_argv[0] = XSTRING (tem)->data; + } + + /* Here we encode arguments by the coding system used for sending + data to the process. We don't support using different coding + systems for encoding arguments and for encoding data sent to the + process. */ + + for (i = 3; i < nargs; i++) + { + tem = args[i]; + CHECK_STRING (tem); + if (STRING_MULTIBYTE (tem)) + tem = (code_convert_string_norecord + (tem, XPROCESS (proc)->encode_coding_system, 1)); + new_argv[i - 2] = XSTRING (tem)->data; + } + new_argv[i - 2] = 0; +#endif /* not VMS */ + XPROCESS (proc)->decoding_buf = make_uninit_string (0); XPROCESS (proc)->decoding_carryover = make_number (0); XPROCESS (proc)->encoding_buf = make_uninit_string (0); @@ -1281,18 +1261,14 @@ start_process_unwind (proc) return Qnil; } - -SIGTYPE -create_process_1 (signo) - int signo; +void +create_process_1 (timer) + struct atimer *timer; { -#if defined (USG) && !defined (POSIX_SIGNALS) - /* USG systems forget handlers when they are used; - must reestablish each time */ - signal (signo, create_process_1); -#endif /* USG */ + /* Nothing to do. */ } + #if 0 /* This doesn't work; see the note before sigchld_handler. */ #ifdef USG #ifdef SIGCHLD @@ -1339,8 +1315,9 @@ create_process (process, new_argv, current_dir) /* Use volatile to protect variables from being clobbered by longjmp. */ volatile int forkin, forkout; volatile int pty_flag = 0; +#ifndef USE_CRT_DLL extern char **environ; - Lisp_Object buffer = XPROCESS (process)->buffer; +#endif inchannel = outchannel = -1; @@ -1444,46 +1421,6 @@ create_process (process, new_argv, current_dir) setup_coding_system (XPROCESS (process)->encode_coding_system, proc_encode_coding_system[outchannel]); - if ((!NILP (buffer) && NILP (XBUFFER (buffer)->enable_multibyte_characters)) - || (NILP (buffer) && NILP (buffer_defaults.enable_multibyte_characters))) - { - /* In unibyte mode, character code conversion should not take - place but EOL conversion should. So, setup raw-text or one - of the subsidiary according to the information just setup. */ - if (!NILP (XPROCESS (process)->decode_coding_system)) - setup_raw_text_coding_system (proc_decode_coding_system[inchannel]); - if (!NILP (XPROCESS (process)->encode_coding_system)) - setup_raw_text_coding_system (proc_encode_coding_system[outchannel]); - } - - if (CODING_REQUIRE_ENCODING (proc_encode_coding_system[outchannel])) - { - /* Here we encode arguments by the coding system used for - sending data to the process. We don't support using - different coding systems for encoding arguments and for - encoding data sent to the process. */ - struct gcpro gcpro1; - int i = 1; - struct coding_system *coding = proc_encode_coding_system[outchannel]; - - coding->mode |= CODING_MODE_LAST_BLOCK; - GCPRO1 (process); - while (new_argv[i] != 0) - { - int len = strlen (new_argv[i]); - int size = encoding_buffer_size (coding, len); - unsigned char *buf = (unsigned char *) alloca (size); - - encode_coding (coding, (unsigned char *)new_argv[i], buf, len, size); - buf[coding->produced] = 0; - /* We don't have to free new_argv[i] because it points to a - Lisp string given as an argument to `start-process'. */ - new_argv[i++] = (char *) buf; - } - UNGCPRO; - coding->mode &= ~CODING_MODE_LAST_BLOCK; - } - /* Delay interrupts until we have a chance to store the new fork's pid in its process structure */ #ifdef POSIX_SIGNALS @@ -1729,14 +1666,22 @@ create_process (process, new_argv, current_dir) /* If the subfork execv fails, and it exits, this close hangs. I don't know why. So have an interrupt jar it loose. */ - stop_polling (); - signal (SIGALRM, create_process_1); - alarm (1); - XPROCESS (process)->subtty = Qnil; - if (forkin >= 0) - emacs_close (forkin); - alarm (0); - start_polling (); + { + struct atimer *timer; + EMACS_TIME offset; + + stop_polling (); + 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); + + cancel_atimer (timer); + start_polling (); + } + if (forkin != forkout && forkout >= 0) emacs_close (forkout); @@ -1797,35 +1742,35 @@ create_process (process, new_argv, current_dir) DEFUN ("open-network-stream", Fopen_network_stream, Sopen_network_stream, 4, 4, 0, - "Open a TCP connection for a service to a host.\n\ -Returns a subprocess-object to represent the connection.\n\ -Input and output work as for subprocesses; `delete-process' closes it.\n\ -Args are NAME BUFFER HOST SERVICE.\n\ -NAME is name for process. It is modified if necessary to make it unique.\n\ -BUFFER is the buffer (or buffer-name) to associate with the process.\n\ - Process output goes at end of that buffer, unless you specify\n\ - an output stream or filter function to handle the output.\n\ - BUFFER may be also nil, meaning that this process is not associated\n\ - with any buffer\n\ -Third arg is name of the host to connect to, or its IP address.\n\ -Fourth arg SERVICE is name of the service desired, or an integer\n\ - specifying a port number to connect to.") - (name, buffer, host, service) + doc: /* Open a TCP connection for a service to a host. +Returns a subprocess-object to represent the connection. +Input and output work as for subprocesses; `delete-process' closes it. +Args are NAME BUFFER HOST SERVICE. +NAME is name for process. It is modified if necessary to make it unique. +BUFFER is the buffer (or buffer-name) to associate with the process. + Process output goes at end of that buffer, unless you specify + an output stream or filter function to handle the output. + BUFFER may be also nil, meaning that this process is not associated + with any buffer +Third arg is name of the host to connect to, or its IP address. +Fourth arg SERVICE is name of the service desired, or an integer +specifying a port number to connect to. */) + (name, buffer, host, service) Lisp_Object name, buffer, host, service; { Lisp_Object proc; -#ifndef HAVE_GETADDRINFO +#ifdef HAVE_GETADDRINFO + struct addrinfo hints, *res, *lres; + int ret = 0; + int xerrno = 0; + char *portstring, portbuf[128]; +#else /* HAVE_GETADDRINFO */ struct sockaddr_in address; struct servent *svc_info; struct hostent *host_info_ptr, host_info; char *(addr_list[2]); IN_ADDR numeric_addr; int port; -#else /* HAVE_GETADDRINFO */ - struct addrinfo hints, *res, *lres; - int ret = 0; - int xerrno = 0; - char *portstring, portbuf[128]; #endif /* HAVE_GETADDRINFO */ int s = -1, outch, inch; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; @@ -1839,73 +1784,75 @@ Fourth arg SERVICE is name of the service desired, or an integer\n\ #endif GCPRO4 (name, buffer, host, service); - CHECK_STRING (name, 0); - CHECK_STRING (host, 0); + CHECK_STRING (name); + CHECK_STRING (host); #ifdef HAVE_GETADDRINFO - /* - * SERVICE can either be a string or int. - * Convert to a C string for later use by getaddrinfo. - */ + /* SERVICE can either be a string or int. + Convert to a C string for later use by getaddrinfo. */ if (INTEGERP (service)) { - sprintf (portbuf, "%d", XINT (service)); + sprintf (portbuf, "%ld", (long) XINT (service)); portstring = portbuf; } else { - CHECK_STRING (service, 0); + CHECK_STRING (service); portstring = XSTRING (service)->data; } -#else /* ! HAVE_GETADDRINFO */ +#else /* HAVE_GETADDRINFO */ if (INTEGERP (service)) port = htons ((unsigned short) XINT (service)); else { - CHECK_STRING (service, 0); + CHECK_STRING (service); svc_info = getservbyname (XSTRING (service)->data, "tcp"); if (svc_info == 0) error ("Unknown service \"%s\"", XSTRING (service)->data); port = svc_info->s_port; } -#endif /* ! HAVE_GETADDRINFO */ +#endif /* HAVE_GETADDRINFO */ /* Slow down polling to every ten seconds. Some kernels have a bug which causes retrying connect to fail after a connect. Polling can interfere with gethostbyname too. */ #ifdef POLL_FOR_INPUT + record_unwind_protect (unwind_stop_other_atimers, Qnil); bind_polling_period (10); #endif #ifndef TERM #ifdef HAVE_GETADDRINFO - { - immediate_quit = 1; - QUIT; - memset (&hints, 0, sizeof (hints)); - hints.ai_flags = 0; - hints.ai_family = AF_UNSPEC; - hints.ai_socktype = SOCK_STREAM; - hints.ai_protocol = 0; - ret = getaddrinfo (XSTRING (host)->data, portstring, &hints, &res); - if (ret) - { - error ("%s/%s %s", XSTRING (host)->data, portstring, - strerror (ret)); - } - immediate_quit = 0; - } + immediate_quit = 1; + QUIT; + memset (&hints, 0, sizeof (hints)); + hints.ai_flags = 0; + hints.ai_family = AF_UNSPEC; + hints.ai_socktype = SOCK_STREAM; + hints.ai_protocol = 0; + ret = getaddrinfo (XSTRING (host)->data, portstring, &hints, &res); + if (ret) +#ifdef HAVE_GAI_STRERROR + error ("%s/%s %s", XSTRING (host)->data, portstring, gai_strerror(ret)); +#else + error ("%s/%s getaddrinfo error %d", XSTRING (host)->data, portstring, + ret); +#endif + immediate_quit = 0; - s = -1; + /* Do this in case we never enter the for-loop below. */ count1 = specpdl_ptr - specpdl; - record_unwind_protect (close_file_unwind, make_number (s)); + s = -1; for (lres = res; lres; lres = lres->ai_next) { s = socket (lres->ai_family, lres->ai_socktype, lres->ai_protocol); - if (s < 0) - continue; + if (s < 0) + { + xerrno = errno; + continue; + } /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR) when connect is interrupted. So let's not let it get interrupted. @@ -1916,12 +1863,50 @@ Fourth arg SERVICE is name of the service desired, or an integer\n\ if (interrupt_input) unrequest_sigio (); + /* Make us close S if quit. */ + count1 = specpdl_ptr - specpdl; + record_unwind_protect (close_file_unwind, make_number (s)); + + loop: + immediate_quit = 1; QUIT; + /* This turns off all alarm-based interrupts; the + bind_polling_period call above doesn't always turn all the + short-interval ones off, especially if interrupt_input is + set. + + It'd be nice to be able to control the connect timeout + though. Would non-blocking connect calls be portable? */ + turn_on_atimers (0); ret = connect (s, lres->ai_addr, lres->ai_addrlen); - if (ret == 0) + xerrno = errno; + turn_on_atimers (1); + + if (ret == 0 || xerrno == EISCONN) + /* The unwind-protect will be discarded afterwards. + Likewise for immediate_quit. */ break; + + immediate_quit = 0; + + if (xerrno == EINTR) + goto loop; + if (xerrno == EADDRINUSE && retry < 20) + { + /* A delay here is needed on some FreeBSD systems, + and it is harmless, since this retrying takes time anyway + and should be infrequent. */ + Fsleep_for (make_number (1), Qnil); + retry++; + goto loop; + } + + /* Discard the unwind protect closing S. */ + specpdl_ptr = specpdl + count1; + count1 = specpdl_ptr - specpdl; + emacs_close (s); s = -1; } @@ -1936,7 +1921,8 @@ Fourth arg SERVICE is name of the service desired, or an integer\n\ report_file_error ("connection failed", Fcons (host, Fcons (name, Qnil))); } -#else /* ! HAVE_GETADDRINFO */ + +#else /* not HAVE_GETADDRINFO */ while (1) { @@ -1957,6 +1943,7 @@ Fourth arg SERVICE is name of the service desired, or an integer\n\ break; Fsleep_for (make_number (1), Qnil); } + if (host_info_ptr == 0) /* Attempt to interpret host as numeric inet address */ { @@ -2038,11 +2025,12 @@ Fourth arg SERVICE is name of the service desired, or an integer\n\ report_file_error ("connection failed", Fcons (host, Fcons (name, Qnil))); } -#endif /* ! HAVE_GETADDRINFO */ + +#endif /* not HAVE_GETADDRINFO */ immediate_quit = 0; - /* Discard the unwind protect. */ + /* Discard the unwind protect, if any. */ specpdl_ptr = specpdl + count1; #ifdef POLL_FOR_INPUT @@ -2246,27 +2234,27 @@ close_process_descs () } DEFUN ("accept-process-output", Faccept_process_output, Saccept_process_output, - 0, 3, 0, - "Allow any pending output from subprocesses to be read by Emacs.\n\ -It is read into the process' buffers or given to their filter functions.\n\ -Non-nil arg PROCESS means do not return until some output has been received\n\ -from PROCESS.\n\ -Non-nil second arg TIMEOUT and third arg TIMEOUT-MSECS are number of\n\ -seconds and microseconds to wait; return after that much time whether\n\ -or not there is input.\n\ -Return non-nil iff we received any output before the timeout expired.") - (process, timeout, timeout_msecs) + 0, 3, 0, + doc: /* Allow any pending output from subprocesses to be read by Emacs. +It is read into the process' buffers or given to their filter functions. +Non-nil arg PROCESS means do not return until some output has been received +from PROCESS. +Non-nil second arg TIMEOUT and third arg TIMEOUT-MSECS are number of +seconds and microseconds to wait; return after that much time whether +or not there is input. +Return non-nil iff we received any output before the timeout expired. */) + (process, timeout, timeout_msecs) register Lisp_Object process, timeout, timeout_msecs; { int seconds; int useconds; if (! NILP (process)) - CHECK_PROCESS (process, 0); + CHECK_PROCESS (process); if (! NILP (timeout_msecs)) { - CHECK_NUMBER (timeout_msecs, 2); + CHECK_NUMBER (timeout_msecs); useconds = XINT (timeout_msecs); if (!INTEGERP (timeout)) XSETINT (timeout, 0); @@ -2292,7 +2280,7 @@ Return non-nil iff we received any output before the timeout expired.") if (! NILP (timeout)) { - CHECK_NUMBER (timeout, 1); + CHECK_NUMBER (timeout); seconds = XINT (timeout); if (seconds < 0 || (seconds == 0 && useconds == 0)) seconds = -1; @@ -2377,7 +2365,9 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) int wait_channel = -1; struct Lisp_Process *wait_proc = 0; int got_some_input = 0; - Lisp_Object *wait_for_cell = 0; + /* Either nil or a cons cell, the car of which is of interest and + may be changed outside of this routine. */ + Lisp_Object wait_for_cell = Qnil; FD_ZERO (&Available); @@ -2393,7 +2383,7 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) /* If waiting for non-nil in a cell, record where. */ if (CONSP (read_kbd)) { - wait_for_cell = &XCAR (read_kbd); + wait_for_cell = read_kbd; XSETFASTINT (read_kbd, 0); } @@ -2413,18 +2403,13 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) Causes "poll: interrupted system call" messages when Emacs is run in an X window Turn off periodic alarms (in case they are in use) */ - stop_polling (); + turn_on_atimers (0); #endif while (1) { int timeout_reduced_for_timers = 0; -#ifdef HAVE_X_WINDOWS - if (display_busy_cursor_p) - Fx_hide_busy_cursor (Qnil); -#endif - /* If calling from keyboard input, do not quit since we want to return C-g as an input character. Otherwise, do pending quit if requested. */ @@ -2432,7 +2417,7 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) QUIT; /* Exit now if the cell we're waiting for became non-nil. */ - if (wait_for_cell && ! NILP (*wait_for_cell)) + if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell))) break; /* Compute time from now till when time limit is up */ @@ -2461,21 +2446,32 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) But not if wait_for_cell; in those cases, the wait is supposed to be short, and those callers cannot handle running arbitrary Lisp code here. */ - if (! wait_for_cell) + if (NILP (wait_for_cell)) { EMACS_TIME timer_delay; - int old_timers_run; - retry: - old_timers_run = timers_run; - timer_delay = timer_check (1); - if (timers_run != old_timers_run && do_display) + do { - redisplay_preserve_echo_area (); - /* We must retry, since a timer may have requeued itself - and that could alter the time_delay. */ - goto retry; + int old_timers_run = timers_run; + struct buffer *old_buffer = current_buffer; + + timer_delay = timer_check (1); + + /* If a timer has run, this might have changed buffers + an alike. Make read_key_sequence aware of that. */ + if (timers_run != old_timers_run + && old_buffer != current_buffer + && waiting_for_user_input_p == -1) + record_asynch_buffer_change (); + + if (timers_run != old_timers_run && do_display) + /* We must retry, since a timer may have requeued itself + and that could alter the time_delay. */ + redisplay_preserve_echo_area (9); + else + break; } + while (!detect_input_pending ()); /* If there is unread keyboard input, also return. */ if (XINT (read_kbd) != 0 @@ -2564,14 +2560,14 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) #endif } if (total_nread > 0 && do_display) - redisplay_preserve_echo_area (); + redisplay_preserve_echo_area (10); break; } /* Wait till there is something to do */ - if (wait_for_cell) + if (!NILP (wait_for_cell)) Available = non_process_wait_mask; else if (! XINT (read_kbd)) Available = non_keyboard_wait_mask; @@ -2586,7 +2582,7 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) if (frame_garbaged && do_display) { clear_waiting_for_input (); - redisplay_preserve_echo_area (); + redisplay_preserve_echo_area (11); if (XINT (read_kbd) < 0) set_waiting_for_input (&timeout); } @@ -2681,14 +2677,30 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) /* If there is any, return immediately to give it higher priority than subprocesses */ - if (XINT (read_kbd) != 0 - && detect_input_pending_run_timers (do_display)) + if (XINT (read_kbd) != 0) { - swallow_events (do_display); + int old_timers_run = timers_run; + struct buffer *old_buffer = current_buffer; + int leave = 0; + if (detect_input_pending_run_timers (do_display)) - break; - } + { + swallow_events (do_display); + if (detect_input_pending_run_timers (do_display)) + leave = 1; + } + /* If a timer has run, this might have changed buffers + an alike. Make read_key_sequence aware of that. */ + if (timers_run != old_timers_run + && waiting_for_user_input_p == -1 + && old_buffer != current_buffer) + record_asynch_buffer_change (); + + if (leave) + break; + } + /* If there is unread keyboard input, also return. */ if (XINT (read_kbd) != 0 && requeued_events_pending_p ()) @@ -2711,7 +2723,7 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) } /* Exit now if the cell we're waiting for became non-nil. */ - if (wait_for_cell && ! NILP (*wait_for_cell)) + if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell))) break; #ifdef SIGIO @@ -2730,7 +2742,7 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) /* If checking input just got us a size-change event from X, obey it now if we should. */ - if (XINT (read_kbd) || wait_for_cell) + if (XINT (read_kbd) || ! NILP (wait_for_cell)) do_pending_window_change (0); /* Check for data from a process. */ @@ -2769,7 +2781,7 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) FD_ZERO (&Available); if (do_display) - redisplay_preserve_echo_area (); + redisplay_preserve_echo_area (12); } #ifdef EWOULDBLOCK else if (nread == -1 && errno == EWOULDBLOCK) @@ -2848,12 +2860,6 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) start_polling (); #endif -#ifdef HAVE_X_WINDOWS - if (display_busy_cursor_p) - if (!inhibit_busy_cursor) - Fx_show_busy_cursor (); -#endif - return got_some_input; } @@ -2874,6 +2880,7 @@ read_process_output_error_handler (error) Vinhibit_quit = Qt; update_echo_area (); Fsleep_for (make_number (2), Qnil); + return Qt; } /* Read pending output from the process channel, @@ -2894,18 +2901,11 @@ read_process_output (proc, channel) { register int nchars, nbytes; char *chars; -#ifdef VMS - int chars_allocated = 0; /* If 1, `chars' should be freed later. */ -#else - char buf[1024]; -#endif register Lisp_Object outstream; register struct buffer *old = current_buffer; register struct Lisp_Process *p = XPROCESS (proc); register int opoint; struct coding_system *coding = proc_decode_coding_system[channel]; - int chars_in_decoding_buf = 0; /* If 1, `chars' points - XSTRING (p->decoding_buf)->data. */ int carryover = XINT (p->decoding_carryover); #ifdef VMS @@ -2933,42 +2933,33 @@ read_process_output (proc, channel) /* The data carried over in the previous decoding (which are at the tail of decoding buffer) should be prepended to the new data read to decode all together. */ - char *buf = (char *) xmalloc (nbytes + carryover); - - bcopy (XSTRING (p->decoding_buf)->data - + STRING_BYTES (XSTRING (p->decoding_buf)) - carryover, - buf, carryover); - bcopy (chars, buf + carryover, nbytes); - chars = buf; - chars_allocated = 1; + chars = (char *) alloca (nbytes + carryover); + bcopy (XSTRING (p->decoding_buf)->data, buf, carryover); + bcopy (vs->inputBuffer, chars + carryover, nbytes); } #else /* not VMS */ - + chars = (char *) alloca (carryover + 1024); if (carryover) /* See the comment above. */ - bcopy (XSTRING (p->decoding_buf)->data - + STRING_BYTES (XSTRING (p->decoding_buf)) - carryover, - buf, carryover); + bcopy (XSTRING (p->decoding_buf)->data, chars, carryover); if (proc_buffered_char[channel] < 0) - nbytes = emacs_read (channel, buf + carryover, (sizeof buf) - carryover); + nbytes = emacs_read (channel, chars + carryover, 1024 - carryover); else { - buf[carryover] = proc_buffered_char[channel]; + chars[carryover] = proc_buffered_char[channel]; proc_buffered_char[channel] = -1; - nbytes = emacs_read (channel, buf + carryover + 1, - (sizeof buf) - carryover - 1); + nbytes = emacs_read (channel, chars + carryover + 1, 1023 - carryover); if (nbytes < 0) nbytes = 1; else nbytes = nbytes + 1; } - chars = buf; #endif /* not VMS */ XSETINT (p->decoding_carryover, 0); - /* At this point, NBYTES holds number of characters just received + /* At this point, NBYTES holds number of bytes just received (including the one in proc_buffered_char[channel]). */ if (nbytes <= 0) { @@ -2979,109 +2970,6 @@ read_process_output (proc, channel) /* Now set NBYTES how many bytes we must decode. */ nbytes += carryover; - nchars = nbytes; - - if (CODING_MAY_REQUIRE_DECODING (coding)) - { - int require = decoding_buffer_size (coding, nbytes); - int result; - - if (STRING_BYTES (XSTRING (p->decoding_buf)) < require) - p->decoding_buf = make_uninit_string (require); - result = decode_coding (coding, chars, XSTRING (p->decoding_buf)->data, - nbytes, STRING_BYTES (XSTRING (p->decoding_buf))); - carryover = nbytes - coding->consumed; - if (carryover > 0) - { - /* Copy the carryover bytes to the end of p->decoding_buf, to - be processed on the next read. Since decoding_buffer_size - asks for an extra amount of space beyond the maximum - expected for the output, there should always be sufficient - space for the carryover (which is by definition a sequence - of bytes that was not long enough to be decoded, and thus - has a bounded length). */ - if (STRING_BYTES (XSTRING (p->decoding_buf)) - < coding->produced + carryover) - abort (); - bcopy (chars + coding->consumed, - XSTRING (p->decoding_buf)->data - + STRING_BYTES (XSTRING (p->decoding_buf)) - carryover, - carryover); - XSETINT (p->decoding_carryover, carryover); - } - - /* A new coding system might be found by `decode_coding'. */ - if (!EQ (p->decode_coding_system, coding->symbol)) - { - p->decode_coding_system = coding->symbol; - - /* Don't call setup_coding_system for - proc_decode_coding_system[channel] here. It is done in - detect_coding called via decode_coding above. */ - - /* If a coding system for encoding is not yet decided, we set - it as the same as coding-system for decoding. - - But, before doing that we must check if - proc_encode_coding_system[p->outfd] surely points to a - valid memory because p->outfd will be changed once EOF is - sent to the process. */ - if (NILP (p->encode_coding_system) - && proc_encode_coding_system[XINT (p->outfd)]) - { - p->encode_coding_system = coding->symbol; - setup_coding_system (coding->symbol, - proc_encode_coding_system[XINT (p->outfd)]); - } - } - -#ifdef VMS - /* Now we don't need the contents of `chars'. */ - if (chars_allocated) - free (chars); -#endif - if (coding->produced == 0) - return 0; - chars = (char *) XSTRING (p->decoding_buf)->data; - nbytes = coding->produced; - nchars = (coding->fake_multibyte - ? multibyte_chars_in_text (chars, nbytes) - : coding->produced_char); - chars_in_decoding_buf = 1; - } - else - { -#ifdef VMS - if (chars_allocated) - { - /* Although we don't have to decode the received data, we - must move it to an area which we don't have to free. */ - if (! STRINGP (p->decoding_buf) - || STRING_BYTES (XSTRING (p->decoding_buf)) < nbytes) - p->decoding_buf = make_uninit_string (nbytes); - bcopy (chars, XSTRING (p->decoding_buf)->data, nbytes); - free (chars); - chars = XSTRING (p->decoding_buf)->data; - chars_in_decoding_buf = 1; - } -#endif - nchars = multibyte_chars_in_text (chars, nbytes); - } - - Vlast_coding_system_used = coding->symbol; - - /* If the caller required, let the process associated buffer - inherit the coding-system used to decode the process output. */ - if (! NILP (p->inherit_coding_system_flag) - && !NILP (p->buffer) && !NILP (XBUFFER (p->buffer)->name)) - { - struct buffer *prev_buf = current_buffer; - - Fset_buffer (p->buffer); - call1 (intern ("after-insert-file-set-buffer-file-coding-system"), - make_number (nbytes)); - set_buffer_internal (prev_buf); - } /* Read and dispose of the process output. */ outstream = p->filter; @@ -3123,19 +3011,50 @@ read_process_output (proc, channel) save the match data in a special nonrecursive fashion. */ running_asynch_code = 1; - /* The multibyteness of a string given to the filter is decided - by which coding system we used for decoding. */ - if (coding->type == coding_type_no_conversion - || coding->type == coding_type_raw_text) - text = make_unibyte_string (chars, nbytes); - else - text = make_multibyte_string (chars, nchars, nbytes); + 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)) + { + p->decode_coding_system = coding->symbol; + + /* Don't call setup_coding_system for + proc_decode_coding_system[channel] here. It is done in + detect_coding called via decode_coding above. */ + + /* If a coding system for encoding is not yet decided, we set + it as the same as coding-system for decoding. - internal_condition_case_1 (read_process_output_call, - Fcons (outstream, - Fcons (proc, Fcons (text, Qnil))), - !NILP (Vdebug_on_error) ? Qnil : Qerror, - read_process_output_error_handler); + But, before doing that we must check if + proc_encode_coding_system[p->outfd] surely points to a + valid memory because p->outfd will be changed once EOF is + sent to the process. */ + if (NILP (p->encode_coding_system) + && proc_encode_coding_system[XINT (p->outfd)]) + { + p->encode_coding_system = coding->symbol; + setup_coding_system (coding->symbol, + proc_encode_coding_system[XINT (p->outfd)]); + } + } + + carryover = nbytes - coding->consumed; + bcopy (chars + coding->consumed, XSTRING (p->decoding_buf)->data, + carryover); + XSETINT (p->decoding_carryover, carryover); + nbytes = STRING_BYTES (XSTRING (text)); + nchars = XSTRING (text)->size; + if (nbytes > 0) + internal_condition_case_1 (read_process_output_call, + Fcons (outstream, + Fcons (proc, Fcons (text, Qnil))), + !NILP (Vdebug_on_error) ? Qnil : Qerror, + read_process_output_error_handler); /* If we saved the match data nonrecursively, restore it now. */ restore_match_data (); @@ -3176,6 +3095,8 @@ read_process_output (proc, channel) Lisp_Object odeactivate; int before, before_byte; int opoint_byte; + Lisp_Object text; + struct buffer *b; odeactivate = Vdeactivate_mark; @@ -3207,27 +3128,46 @@ read_process_output (proc, channel) if (! (BEGV <= PT && PT <= ZV)) Fwiden (); - if (NILP (current_buffer->enable_multibyte_characters)) - nchars = nbytes; - - /* Insert before markers in case we are inserting where - the buffer's mark is, and the user's next command is Meta-y. */ - if (chars_in_decoding_buf) + text = decode_coding_string (make_unibyte_string (chars, nbytes), + coding, 0); + Vlast_coding_system_used = coding->symbol; + /* A new coding system might be found. See the comment in the + similar code in the previous `if' block. */ + if (!EQ (p->decode_coding_system, coding->symbol)) { - /* Since multibyteness of p->docoding_buf is corrupted, we - can't use insert_from_string_before_markers. */ - char *temp_buf; - - temp_buf = (char *) alloca (nbytes); - bcopy (XSTRING (p->decoding_buf)->data, temp_buf, nbytes); - insert_before_markers (temp_buf, nbytes); + p->decode_coding_system = coding->symbol; + if (NILP (p->encode_coding_system) + && proc_encode_coding_system[XINT (p->outfd)]) + { + p->encode_coding_system = coding->symbol; + setup_coding_system (coding->symbol, + proc_encode_coding_system[XINT (p->outfd)]); + } } + carryover = nbytes - coding->consumed; + bcopy (chars + coding->consumed, XSTRING (p->decoding_buf)->data, + carryover); + XSETINT (p->decoding_carryover, carryover); + /* Adjust the multibyteness of TEXT to that of the buffer. */ + if (NILP (current_buffer->enable_multibyte_characters) + != ! STRING_MULTIBYTE (text)) + text = (STRING_MULTIBYTE (text) + ? Fstring_as_unibyte (text) + : Fstring_as_multibyte (text)); + nbytes = STRING_BYTES (XSTRING (text)); + nchars = XSTRING (text)->size; + /* Insert before markers in case we are inserting where + the buffer's mark is, and the user's next command is Meta-y. */ + insert_from_string_before_markers (text, 0, 0, nchars, nbytes, 0); + + /* Make sure the process marker's position is valid when the + process buffer is changed in the signal_after_change above. + W3 is known to do that. */ + if (BUFFERP (p->buffer) + && (b = XBUFFER (p->buffer), b != current_buffer)) + set_marker_both (p->mark, p->buffer, BUF_PT (b), BUF_PT_BYTE (b)); else - { - insert_1_both (chars, nchars, nbytes, 0, 1, 1); - signal_after_change (opoint, 0, PT - opoint); - } - set_marker_both (p->mark, p->buffer, PT, PT_BYTE); + set_marker_both (p->mark, p->buffer, PT, PT_BYTE); update_mode_lines++; @@ -3268,9 +3208,9 @@ read_process_output (proc, channel) DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p, Swaiting_for_user_input_p, 0, 0, 0, - "Returns non-nil if emacs is waiting for input from the user.\n\ -This is intended for use by asynchronous process output filters and sentinels.") - () + doc: /* Returns non-nil if emacs is waiting for input from the user. +This is intended for use by asynchronous process output filters and sentinels. */) + () { return (waiting_for_user_input_p ? Qt : Qnil); } @@ -3278,6 +3218,7 @@ This is intended for use by asynchronous process output filters and sentinels.") /* Sending data to subprocess */ jmp_buf send_process_frame; +Lisp_Object process_sent_to; SIGTYPE send_process_trap () @@ -3291,27 +3232,25 @@ send_process_trap () /* Send some data to process PROC. BUF is the beginning of the data; LEN is the number of characters. - OBJECT is the Lisp object that the data comes from. + OBJECT is the Lisp object that the data comes from. If OBJECT is + nil or t, it means that the data comes from C string. + + If OBJECT is not nil, the data is encoded by PROC's coding-system + for encoding before it is sent. - The data is encoded by PROC's coding-system for encoding before it - is sent. But if the data ends at the middle of multi-byte - representation, that incomplete sequence of bytes are sent without - being encoded. Should we store them in a buffer to prepend them to - the data send later? */ + This function can evaluate Lisp code and can garbage collect. */ void send_process (proc, buf, len, object) volatile Lisp_Object proc; - unsigned char *buf; - int len; - Lisp_Object object; + unsigned char *volatile buf; + volatile int len; + volatile Lisp_Object object; { /* Use volatile to protect variables from being clobbered by longjmp. */ int rv; - volatile unsigned char *procname = XSTRING (XPROCESS (proc)->name)->data; struct coding_system *coding; struct gcpro gcpro1; - int carryover = XINT (XPROCESS (proc)->encoding_carryover); GCPRO1 (object); @@ -3323,64 +3262,86 @@ send_process (proc, buf, len, object) if (! NILP (XPROCESS (proc)->raw_status_low)) update_status (XPROCESS (proc)); if (! EQ (XPROCESS (proc)->status, Qrun)) - error ("Process %s not running", procname); + error ("Process %s not running", + XSTRING (XPROCESS (proc)->name)->data); if (XINT (XPROCESS (proc)->outfd) < 0) - error ("Output file descriptor of %s is closed", procname); + error ("Output file descriptor of %s is closed", + XSTRING (XPROCESS (proc)->name)->data); coding = proc_encode_coding_system[XINT (XPROCESS (proc)->outfd)]; Vlast_coding_system_used = coding->symbol; + if ((STRINGP (object) && STRING_MULTIBYTE (object)) + || (BUFFERP (object) + && !NILP (XBUFFER (object)->enable_multibyte_characters)) + || EQ (object, Qt)) + { + coding->src_multibyte = 1; + if (!EQ (coding->symbol, XPROCESS (proc)->encode_coding_system)) + /* The coding system for encoding was changed to raw-text + because we sent a unibyte text previously. Now we are + sending a multibyte text, thus we must encode it by the + original coding system specified for the current + process. */ + setup_coding_system (XPROCESS (proc)->encode_coding_system, + coding); + } + else + { + /* For sending a unibyte text, character code conversion should + not take place but EOL conversion should. So, setup raw-text + or one of the subsidiary if we have not yet done it. */ + if (coding->type != coding_type_raw_text) + { + if (CODING_REQUIRE_FLUSHING (coding)) + { + /* But, before changing the coding, we must flush out data. */ + coding->mode |= CODING_MODE_LAST_BLOCK; + send_process (proc, "", 0, Qt); + } + coding->src_multibyte = 0; + setup_raw_text_coding_system (coding); + } + } + coding->dst_multibyte = 0; + if (CODING_REQUIRE_ENCODING (coding)) { int require = encoding_buffer_size (coding, len); - int offset; + int from_byte = -1, from = -1, to = -1; unsigned char *temp_buf = NULL; - /* Remember the offset of data because a string or a buffer may - be relocated. Setting OFFSET to -1 means we don't have to - care about relocation. */ - offset = (BUFFERP (object) - ? BUF_PTR_BYTE_POS (XBUFFER (object), buf) - : (STRINGP (object) - ? buf - XSTRING (object)->data - : -1)); - - if (carryover > 0) + if (BUFFERP (object)) + { + from_byte = BUF_PTR_BYTE_POS (XBUFFER (object), buf); + from = buf_bytepos_to_charpos (XBUFFER (object), from_byte); + to = buf_bytepos_to_charpos (XBUFFER (object), from_byte + len); + } + else if (STRINGP (object)) { - temp_buf = (unsigned char *) xmalloc (len + carryover); + from_byte = buf - XSTRING (object)->data; + from = string_byte_to_char (object, from_byte); + to = string_byte_to_char (object, from_byte + len); + } - if (offset >= 0) - { - if (BUFFERP (object)) - buf = BUF_BYTE_ADDRESS (XBUFFER (object), offset); - else if (STRINGP (object)) - buf = offset + XSTRING (object)->data; - /* Now we don't have to care about relocation. */ - offset = -1; - } - bcopy ((XSTRING (XPROCESS (proc)->encoding_buf)->data - + STRING_BYTES (XSTRING (XPROCESS (proc)->encoding_buf)) - - carryover), - temp_buf, - carryover); - bcopy (buf, temp_buf + carryover, len); - buf = temp_buf; + if (coding->composing != COMPOSITION_DISABLED) + { + if (from_byte >= 0) + coding_save_composition (coding, from, to, object); + else + coding->composing = COMPOSITION_DISABLED; } if (STRING_BYTES (XSTRING (XPROCESS (proc)->encoding_buf)) < require) - { - XPROCESS (proc)->encoding_buf = make_uninit_string (require); + XPROCESS (proc)->encoding_buf = make_uninit_string (require); + + if (from_byte >= 0) + buf = (BUFFERP (object) + ? BUF_BYTE_ADDRESS (XBUFFER (object), from_byte) + : XSTRING (object)->data + from_byte); - if (offset >= 0) - { - if (BUFFERP (object)) - buf = BUF_BYTE_ADDRESS (XBUFFER (object), offset); - else if (STRINGP (object)) - buf = offset + XSTRING (object)->data; - } - } object = XPROCESS (proc)->encoding_buf; - encode_coding (coding, buf, XSTRING (object)->data, + encode_coding (coding, (char *) buf, XSTRING (object)->data, len, STRING_BYTES (XSTRING (object))); len = coding->produced; buf = XSTRING (object)->data; @@ -3394,7 +3355,7 @@ send_process (proc, buf, len, object) error ("Could not find this process: %x", p->pid); else if (write_to_vms_process (vs, buf, len)) ; -#else +#else /* not VMS */ if (pty_max_bytes == 0) { @@ -3410,111 +3371,149 @@ send_process (proc, buf, len, object) pty_max_bytes--; } + /* 2000-09-21: Emacs 20.7, sparc-sun-solaris-2.6, GCC 2.95.2, + CFLAGS="-g -O": The value of the parameter `proc' is clobbered + when returning with longjmp despite being declared volatile. */ if (!setjmp (send_process_frame)) - while (len > 0) - { - int this = len; - SIGTYPE (*old_sigpipe)(); + { + process_sent_to = proc; + while (len > 0) + { + int this = len; + SIGTYPE (*old_sigpipe)(); - /* Decide how much data we can send in one batch. - Long lines need to be split into multiple batches. */ - if (!NILP (XPROCESS (proc)->pty_flag)) - { - /* Starting this at zero is always correct when not the first iteration - because the previous iteration ended by sending C-d. - It may not be correct for the first iteration - if a partial line was sent in a separate send_process call. - If that proves worth handling, we need to save linepos - in the process object. */ - int linepos = 0; - unsigned char *ptr = buf; - unsigned char *end = buf + len; - - /* Scan through this text for a line that is too long. */ - while (ptr != end && linepos < pty_max_bytes) - { - if (*ptr == '\n') - linepos = 0; - else - linepos++; - ptr++; - } - /* If we found one, break the line there - and put in a C-d to force the buffer through. */ - this = ptr - buf; - } + /* Decide how much data we can send in one batch. + Long lines need to be split into multiple batches. */ + if (!NILP (XPROCESS (proc)->pty_flag)) + { + /* Starting this at zero is always correct when not the first + iteration because the previous iteration ended by sending C-d. + It may not be correct for the first iteration + if a partial line was sent in a separate send_process call. + If that proves worth handling, we need to save linepos + in the process object. */ + int linepos = 0; + unsigned char *ptr = (unsigned char *) buf; + unsigned char *end = (unsigned char *) buf + len; + + /* Scan through this text for a line that is too long. */ + while (ptr != end && linepos < pty_max_bytes) + { + if (*ptr == '\n') + linepos = 0; + else + linepos++; + ptr++; + } + /* If we found one, break the line there + and put in a C-d to force the buffer through. */ + this = ptr - buf; + } - /* Send this batch, using one or more write calls. */ - while (this > 0) - { - old_sigpipe = (SIGTYPE (*) ()) signal (SIGPIPE, send_process_trap); - rv = emacs_write (XINT (XPROCESS (proc)->outfd), buf, this); - signal (SIGPIPE, old_sigpipe); + /* Send this batch, using one or more write calls. */ + while (this > 0) + { + old_sigpipe = (SIGTYPE (*) ()) signal (SIGPIPE, send_process_trap); + rv = emacs_write (XINT (XPROCESS (proc)->outfd), + (char *) buf, this); + signal (SIGPIPE, old_sigpipe); - if (rv < 0) - { - if (0 + if (rv < 0) + { + if (0 #ifdef EWOULDBLOCK - || errno == EWOULDBLOCK + || errno == EWOULDBLOCK #endif #ifdef EAGAIN - || errno == EAGAIN + || errno == EAGAIN #endif - ) - /* Buffer is full. Wait, accepting input; - that may allow the program - to finish doing output and read more. */ - { - Lisp_Object zero; - int offset; - - /* Running filters might relocate buffers or strings. - Arrange to relocate BUF. */ - if (BUFFERP (object)) - offset = BUF_PTR_BYTE_POS (XBUFFER (object), buf); - else if (STRINGP (object)) - offset = buf - XSTRING (object)->data; - - XSETFASTINT (zero, 0); + ) + /* Buffer is full. Wait, accepting input; + that may allow the program + to finish doing output and read more. */ + { + Lisp_Object zero; + int offset = 0; + +#ifdef BROKEN_PTY_READ_AFTER_EAGAIN + /* A gross hack to work around a bug in FreeBSD. + In the following sequence, read(2) returns + bogus data: + + write(2) 1022 bytes + write(2) 954 bytes, get EAGAIN + read(2) 1024 bytes in process_read_output + read(2) 11 bytes in process_read_output + + That is, read(2) returns more bytes than have + ever been written successfully. The 1033 bytes + read are the 1022 bytes written successfully + after processing (for example with CRs added if + the terminal is set up that way which it is + here). The same bytes will be seen again in a + later read(2), without the CRs. */ + + if (errno == EAGAIN) + { + int flags = FWRITE; + ioctl (XINT (XPROCESS (proc)->outfd), TIOCFLUSH, + &flags); + } +#endif /* BROKEN_PTY_READ_AFTER_EAGAIN */ + + /* Running filters might relocate buffers or strings. + Arrange to relocate BUF. */ + if (BUFFERP (object)) + offset = BUF_PTR_BYTE_POS (XBUFFER (object), buf); + else if (STRINGP (object)) + offset = buf - XSTRING (object)->data; + + XSETFASTINT (zero, 0); #ifdef EMACS_HAS_USECS - wait_reading_process_input (0, 20000, zero, 0); + wait_reading_process_input (0, 20000, zero, 0); #else - wait_reading_process_input (1, 0, zero, 0); + wait_reading_process_input (1, 0, zero, 0); #endif - if (BUFFERP (object)) - buf = BUF_BYTE_ADDRESS (XBUFFER (object), offset); - else if (STRINGP (object)) - buf = offset + XSTRING (object)->data; + if (BUFFERP (object)) + buf = BUF_BYTE_ADDRESS (XBUFFER (object), offset); + else if (STRINGP (object)) + buf = offset + XSTRING (object)->data; - rv = 0; - } - else - /* This is a real error. */ - report_file_error ("writing to process", Fcons (proc, Qnil)); - } - buf += rv; - len -= rv; - this -= rv; - } + rv = 0; + } + else + /* This is a real error. */ + report_file_error ("writing to process", Fcons (proc, Qnil)); + } + buf += rv; + len -= rv; + this -= rv; + } - /* If we sent just part of the string, put in an EOF - to force it through, before we send the rest. */ - if (len > 0) - Fprocess_send_eof (proc); - } -#endif + /* If we sent just part of the string, put in an EOF + to force it through, before we send the rest. */ + if (len > 0) + Fprocess_send_eof (proc); + } + } +#endif /* not VMS */ else { +#ifndef VMS + proc = process_sent_to; +#endif XPROCESS (proc)->raw_status_low = Qnil; XPROCESS (proc)->raw_status_high = Qnil; XPROCESS (proc)->status = Fcons (Qexit, Fcons (make_number (256), Qnil)); XSETINT (XPROCESS (proc)->tick, ++process_tick); deactivate_process (proc); #ifdef VMS - error ("Error writing to process %s; closed it", procname); + error ("Error writing to process %s; closed it", + XSTRING (XPROCESS (proc)->name)->data); #else - error ("SIGPIPE raised on process %s; closed it", procname); + error ("SIGPIPE raised on process %s; closed it", + XSTRING (XPROCESS (proc)->name)->data); #endif } @@ -3522,15 +3521,15 @@ send_process (proc, buf, len, object) } DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region, - 3, 3, 0, - "Send current contents of region as input to PROCESS.\n\ -PROCESS may be a process, a buffer, the name of a process or buffer, or\n\ -nil, indicating the current buffer's process.\n\ -Called from program, takes three arguments, PROCESS, START and END.\n\ -If the region is more than 500 characters long,\n\ -it is sent in several bunches. This may happen even for shorter regions.\n\ -Output from processes can arrive in between bunches.") - (process, start, end) + 3, 3, 0, + doc: /* Send current contents of region as input to PROCESS. +PROCESS may be a process, a buffer, the name of a process or buffer, or +nil, indicating the current buffer's process. +Called from program, takes three arguments, PROCESS, START and END. +If the region is more than 500 characters long, +it is sent in several bunches. This may happen even for shorter regions. +Output from processes can arrive in between bunches. */) + (process, start, end) Lisp_Object process, start, end; { Lisp_Object proc; @@ -3551,18 +3550,18 @@ Output from processes can arrive in between bunches.") } DEFUN ("process-send-string", Fprocess_send_string, Sprocess_send_string, - 2, 2, 0, - "Send PROCESS the contents of STRING as input.\n\ -PROCESS may be a process, a buffer, the name of a process or buffer, or\n\ -nil, indicating the current buffer's process.\n\ -If STRING is more than 500 characters long,\n\ -it is sent in several bunches. This may happen even for shorter strings.\n\ -Output from processes can arrive in between bunches.") - (process, string) + 2, 2, 0, + doc: /* Send PROCESS the contents of STRING as input. +PROCESS may be a process, a buffer, the name of a process or buffer, or +nil, indicating the current buffer's process. +If STRING is more than 500 characters long, +it is sent in several bunches. This may happen even for shorter strings. +Output from processes can arrive in between bunches. */) + (process, string) Lisp_Object process, string; { Lisp_Object proc; - CHECK_STRING (string, 1); + CHECK_STRING (string); proc = get_process (process); send_process (proc, XSTRING (string)->data, STRING_BYTES (XSTRING (string)), string); @@ -3571,10 +3570,10 @@ Output from processes can arrive in between bunches.") DEFUN ("process-running-child-p", Fprocess_running_child_p, Sprocess_running_child_p, 0, 1, 0, - "Return t if PROCESS has given the terminal to a child.\n\ -If the operating system does not make it possible to find out,\n\ -return t unconditionally.") - (process) + doc: /* Return t if PROCESS has given the terminal to a child. +If the operating system does not make it possible to find out, +return t unconditionally. */) + (process) Lisp_Object process; { /* Initialize in case ioctl doesn't exist or gives an error, @@ -3831,18 +3830,18 @@ process_send_signal (process, signo, current_group, nomsg) } DEFUN ("interrupt-process", Finterrupt_process, Sinterrupt_process, 0, 2, 0, - "Interrupt process PROCESS.\n\ -PROCESS may be a process, a buffer, or the name of a process or buffer.\n\ -nil or no arg means current buffer's process.\n\ -Second arg CURRENT-GROUP non-nil means send signal to\n\ -the current process-group of the process's controlling terminal\n\ -rather than to the process's own process group.\n\ -If the process is a shell, this means interrupt current subjob\n\ -rather than the shell.\n\ -\n\ -If CURRENT-GROUP is `lambda', and if the shell owns the terminal,\n\ -don't send the signal.") - (process, current_group) + doc: /* Interrupt process PROCESS. +PROCESS may be a process, a buffer, or the name of a process or buffer. +nil or no arg means current buffer's process. +Second arg CURRENT-GROUP non-nil means send signal to +the current process-group of the process's controlling terminal +rather than to the process's own process group. +If the process is a shell, this means interrupt current subjob +rather than the shell. + +If CURRENT-GROUP is `lambda', and if the shell owns the terminal, +don't send the signal. */) + (process, current_group) Lisp_Object process, current_group; { process_send_signal (process, SIGINT, current_group, 0); @@ -3850,9 +3849,9 @@ don't send the signal.") } DEFUN ("kill-process", Fkill_process, Skill_process, 0, 2, 0, - "Kill process PROCESS. May be process or name of one.\n\ -See function `interrupt-process' for more details on usage.") - (process, current_group) + doc: /* Kill process PROCESS. May be process or name of one. +See function `interrupt-process' for more details on usage. */) + (process, current_group) Lisp_Object process, current_group; { process_send_signal (process, SIGKILL, current_group, 0); @@ -3860,9 +3859,9 @@ See function `interrupt-process' for more details on usage.") } DEFUN ("quit-process", Fquit_process, Squit_process, 0, 2, 0, - "Send QUIT signal to process PROCESS. May be process or name of one.\n\ -See function `interrupt-process' for more details on usage.") - (process, current_group) + doc: /* Send QUIT signal to process PROCESS. May be process or name of one. +See function `interrupt-process' for more details on usage. */) + (process, current_group) Lisp_Object process, current_group; { process_send_signal (process, SIGQUIT, current_group, 0); @@ -3870,9 +3869,9 @@ See function `interrupt-process' for more details on usage.") } DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0, - "Stop process PROCESS. May be process or name of one.\n\ -See function `interrupt-process' for more details on usage.") - (process, current_group) + doc: /* Stop process PROCESS. May be process or name of one. +See function `interrupt-process' for more details on usage. */) + (process, current_group) Lisp_Object process, current_group; { #ifndef SIGTSTP @@ -3884,9 +3883,9 @@ See function `interrupt-process' for more details on usage.") } DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0, - "Continue process PROCESS. May be process or name of one.\n\ -See function `interrupt-process' for more details on usage.") - (process, current_group) + doc: /* Continue process PROCESS. May be process or name of one. +See function `interrupt-process' for more details on usage. */) + (process, current_group) Lisp_Object process, current_group; { #ifdef SIGCONT @@ -3898,14 +3897,14 @@ See function `interrupt-process' for more details on usage.") } DEFUN ("signal-process", Fsignal_process, Ssignal_process, - 2, 2, "nProcess number: \nnSignal code: ", - "Send the process with process id PID the signal with code SIGCODE.\n\ -PID must be an integer. The process need not be a child of this Emacs.\n\ -SIGCODE may be an integer, or a symbol whose name is a signal name.") - (pid, sigcode) + 2, 2, "nProcess number: \nnSignal code: ", + doc: /* Send the process with process id PID the signal with code SIGCODE. +PID must be an integer. The process need not be a child of this Emacs. +SIGCODE may be an integer, or a symbol whose name is a signal name. */) + (pid, sigcode) Lisp_Object pid, sigcode; { - CHECK_NUMBER (pid, 0); + CHECK_NUMBER (pid); #define handle_signal(NAME, VALUE) \ else if (!strcmp (name, NAME)) \ @@ -3917,7 +3916,7 @@ SIGCODE may be an integer, or a symbol whose name is a signal name.") { unsigned char *name; - CHECK_SYMBOL (sigcode, 1); + CHECK_SYMBOL (sigcode); name = XSYMBOL (sigcode)->name->data; if (0) @@ -4022,14 +4021,14 @@ SIGCODE may be an integer, or a symbol whose name is a signal name.") } DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0, - "Make PROCESS see end-of-file in its input.\n\ -EOF comes after any text already sent to it.\n\ -PROCESS may be a process, a buffer, the name of a process or buffer, or\n\ -nil, indicating the current buffer's process.\n\ -If PROCESS is a network connection, or is a process communicating\n\ -through a pipe (as opposed to a pty), then you cannot send any more\n\ -text to PROCESS after you call this function.") - (process) + doc: /* Make PROCESS see end-of-file in its input. +EOF comes after any text already sent to it. +PROCESS may be a process, a buffer, the name of a process or buffer, or +nil, indicating the current buffer's process. +If PROCESS is a network connection, or is a process communicating +through a pipe (as opposed to a pty), then you cannot send any more +text to PROCESS after you call this function. */) + (process) Lisp_Object process; { Lisp_Object proc; @@ -4092,7 +4091,7 @@ text to PROCESS after you call this function.") } /* Kill all processes associated with `buffer'. - If `buffer' is nil, kill all processes */ + If `buffer' is nil, kill all processes */ void kill_buffer_processes (buffer) @@ -4114,26 +4113,27 @@ kill_buffer_processes (buffer) } } -/* On receipt of a signal that a child status has changed, - loop asking about children with changed statuses until - the system says there are no more. - All we do is change the status; - we do not run sentinels or print notifications. - That is saved for the next time keyboard input is done, - in order to avoid timing errors. */ - -/** WARNING: this can be called during garbage collection. - Therefore, it must not be fooled by the presence of mark bits in - Lisp objects. */ - -/** USG WARNING: Although it is not obvious from the documentation - in signal(2), on a USG system the SIGCLD handler MUST NOT call - signal() before executing at least one wait(), otherwise the handler - will be called again, resulting in an infinite loop. The relevant - portion of the documentation reads "SIGCLD signals will be queued - and the signal-catching function will be continually reentered until - the queue is empty". Invoking signal() causes the kernel to reexamine - the SIGCLD queue. Fred Fish, UniSoft Systems Inc. */ +/* On receipt of a signal that a child status has changed, loop asking + about children with changed statuses until the system says there + are no more. + + All we do is change the status; we do not run sentinels or print + notifications. That is saved for the next time keyboard input is + done, in order to avoid timing errors. + + ** WARNING: this can be called during garbage collection. + Therefore, it must not be fooled by the presence of mark bits in + Lisp objects. + + ** USG WARNING: Although it is not obvious from the documentation + in signal(2), on a USG system the SIGCLD handler MUST NOT call + signal() before executing at least one wait(), otherwise the + handler will be called again, resulting in an infinite loop. The + relevant portion of the documentation reads "SIGCLD signals will be + queued and the signal-catching function will be continually + reentered until the queue is empty". Invoking signal() causes the + kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems + Inc. */ SIGTYPE sigchld_handler (signo) @@ -4165,11 +4165,12 @@ sigchld_handler (signo) errno = 0; pid = wait3 (&w, WNOHANG | WUNTRACED, 0); } - while (pid <= 0 && errno == EINTR); + while (pid < 0 && errno == EINTR); if (pid <= 0) { - /* A real failure. We have done all our job, so return. */ + /* PID == 0 means no processes found, PID == -1 means a real + failure. We have done all our job, so return. */ /* USG systems forget handlers when they are used; must reestablish each time */ @@ -4190,11 +4191,11 @@ sigchld_handler (signo) /* Find the process that signaled us, and record its status. */ p = 0; - for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail)) + for (tail = Vprocess_alist; GC_CONSP (tail); tail = XCDR (tail)) { proc = XCDR (XCAR (tail)); p = XPROCESS (proc); - if (EQ (p->childp, Qt) && XFASTINT (p->pid) == pid) + if (GC_EQ (p->childp, Qt) && XINT (p->pid) == pid) break; p = 0; } @@ -4202,11 +4203,11 @@ sigchld_handler (signo) /* Look for an asynchronous process whose pid hasn't been filled in yet. */ if (p == 0) - for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail)) + for (tail = Vprocess_alist; GC_CONSP (tail); tail = XCDR (tail)) { proc = XCDR (XCAR (tail)); p = XPROCESS (proc); - if (INTEGERP (p->pid) && XINT (p->pid) == -1) + if (GC_INTEGERP (p->pid) && XINT (p->pid) == -1) break; p = 0; } @@ -4254,7 +4255,7 @@ sigchld_handler (signo) int code = WTERMSIG (w); char *signame; - synchronize_messages_locale (); + synchronize_system_messages_locale (); signame = strsignal (code); if (signame == 0) @@ -4274,7 +4275,9 @@ sigchld_handler (signo) get another signal. Otherwise (on systems that have WNOHANG), loop around to use up all the processes that have something to tell us. */ -#if defined (USG) && ! (defined (HPUX) && defined (WNOHANG)) || defined (WINDOWSNT) +#if (defined WINDOWSNT \ + || (defined USG && !defined LINUX \ + && !(defined HPUX && defined WNOHANG))) #if defined (USG) && ! defined (POSIX_SIGNALS) signal (signo, sigchld_handler); #endif @@ -4301,6 +4304,7 @@ exec_sentinel_error_handler (error) Vinhibit_quit = Qt; update_echo_area (); Fsleep_for (make_number (2), Qnil); + return Qt; } static void @@ -4496,7 +4500,7 @@ status_notify () } /* end for */ update_mode_lines++; /* in case buffers use %s in mode-line-format */ - redisplay_preserve_echo_area (); + redisplay_preserve_echo_area (13); UNGCPRO; } @@ -4504,15 +4508,15 @@ status_notify () DEFUN ("set-process-coding-system", Fset_process_coding_system, Sset_process_coding_system, 1, 3, 0, - "Set coding systems of PROCESS to DECODING and ENCODING.\n\ -DECODING will be used to decode subprocess output and ENCODING to\n\ -encode subprocess input.") - (proc, decoding, encoding) + doc: /* Set coding systems of PROCESS to DECODING and ENCODING. +DECODING will be used to decode subprocess output and ENCODING to +encode subprocess input. */) + (proc, decoding, encoding) register Lisp_Object proc, decoding, encoding; { register struct Lisp_Process *p; - CHECK_PROCESS (proc, 0); + CHECK_PROCESS (proc); p = XPROCESS (proc); if (XINT (p->infd) < 0) error ("Input file descriptor of %s closed", XSTRING (p->name)->data); @@ -4531,11 +4535,11 @@ encode subprocess input.") DEFUN ("process-coding-system", Fprocess_coding_system, Sprocess_coding_system, 1, 1, 0, - "Return a cons of coding systems for decoding and encoding of PROCESS.") - (proc) + doc: /* Return a cons of coding systems for decoding and encoding of PROCESS. */) + (proc) register Lisp_Object proc; { - CHECK_PROCESS (proc, 0); + CHECK_PROCESS (proc); return Fcons (XPROCESS (proc)->decode_coding_system, XPROCESS (proc)->encode_coding_system); } @@ -4623,11 +4627,6 @@ init_process () } bzero (proc_decode_coding_system, sizeof proc_decode_coding_system); bzero (proc_encode_coding_system, sizeof proc_encode_coding_system); - - Vdefault_process_coding_system - = (NILP (buffer_defaults.enable_multibyte_characters) - ? Fcons (Qraw_text, Qnil) - : Fcons (Qemacs_mule, Qnil)); } void @@ -4659,17 +4658,17 @@ syms_of_process () staticpro (&Vprocess_alist); DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes, - "*Non-nil means delete processes immediately when they exit.\n\ -nil means don't delete them until `list-processes' is run."); + doc: /* *Non-nil means delete processes immediately when they exit. +nil means don't delete them until `list-processes' is run. */); delete_exited_processes = 1; DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type, - "Control type of device used to communicate with subprocesses.\n\ -Values are nil to use a pipe, or t or `pty' to use a pty.\n\ -The value has no effect if the system has no ptys or if all ptys are busy:\n\ -then a pipe is used in any case.\n\ -The value takes effect when `start-process' is called."); + doc: /* Control type of device used to communicate with subprocesses. +Values are nil to use a pipe, or t or `pty' to use a pty. +The value has no effect if the system has no ptys or if all ptys are busy: +then a pipe is used in any case. +The value takes effect when `start-process' is called. */); Vprocess_connection_type = Qt; defsubr (&Sprocessp); @@ -4769,12 +4768,14 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) EMACS_TIME end_time, timeout; SELECT_TYPE waitchannels; int xerrno; - Lisp_Object *wait_for_cell = 0; + /* Either nil or a cons cell, the car of which is of interest and + may be changed outside of this routine. */ + Lisp_Object wait_for_cell = Qnil; /* If waiting for non-nil in a cell, record where. */ if (CONSP (read_kbd)) { - wait_for_cell = &XCAR (read_kbd); + wait_for_cell = read_kbd; XSETFASTINT (read_kbd, 0); } @@ -4788,7 +4789,7 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) /* Turn off periodic alarms (in case they are in use) because the select emulator uses alarms. */ - stop_polling (); + turn_on_atimers (0); while (1) { @@ -4801,7 +4802,7 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) QUIT; /* Exit now if the cell we're waiting for became non-nil. */ - if (wait_for_cell && ! NILP (*wait_for_cell)) + if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell))) break; /* Compute time from now till when time limit is up */ @@ -4830,21 +4831,22 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) run timer events directly. (Callers that will immediately read keyboard events call timer_delay on their own.) */ - if (! wait_for_cell) + if (NILP (wait_for_cell)) { EMACS_TIME timer_delay; - int old_timers_run; - retry: - old_timers_run = timers_run; - timer_delay = timer_check (1); - if (timers_run != old_timers_run && do_display) + do { - redisplay_preserve_echo_area (); - /* We must retry, since a timer may have requeued itself - and that could alter the time delay. */ - goto retry; + int old_timers_run = timers_run; + timer_delay = timer_check (1); + if (timers_run != old_timers_run && do_display) + /* We must retry, since a timer may have requeued itself + and that could alter the time delay. */ + redisplay_preserve_echo_area (14); + else + break; } + while (!detect_input_pending ()); /* If there is unread keyboard input, also return. */ if (XINT (read_kbd) != 0 @@ -4870,7 +4872,7 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) /* Wait till there is something to do. */ - if (! XINT (read_kbd) && wait_for_cell == 0) + if (! XINT (read_kbd) && NILP (wait_for_cell)) FD_ZERO (&waitchannels); else FD_SET (0, &waitchannels); @@ -4880,7 +4882,7 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) if (frame_garbaged && do_display) { clear_waiting_for_input (); - redisplay_preserve_echo_area (); + redisplay_preserve_echo_area (15); if (XINT (read_kbd) < 0) set_waiting_for_input (&timeout); } @@ -4946,7 +4948,7 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) input at all when wait_for_cell, but the code has been this way since July 1994. Try changing this after version 19.31.) */ - if (wait_for_cell + if (! NILP (wait_for_cell) && detect_input_pending ()) { swallow_events (do_display); @@ -4955,7 +4957,7 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) } /* Exit now if the cell we're waiting for became non-nil. */ - if (wait_for_cell && ! NILP (*wait_for_cell)) + if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell))) break; } @@ -4965,23 +4967,23 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) } +/* Don't confuse make-docfile by having two doc strings for this function. + make-docfile does not pay attention to #if, for good reason! */ DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0, - /* Don't confuse make-docfile by having two doc strings for this function. - make-docfile does not pay attention to #if, for good reason! */ - 0) - (name) + 0) + (name) register Lisp_Object name; { return Qnil; } -DEFUN ("process-inherit-coding-system-flag", - Fprocess_inherit_coding_system_flag, Sprocess_inherit_coding_system_flag, - 1, 1, 0, /* Don't confuse make-docfile by having two doc strings for this function. make-docfile does not pay attention to #if, for good reason! */ - 0) - (process) +DEFUN ("process-inherit-coding-system-flag", + Fprocess_inherit_coding_system_flag, Sprocess_inherit_coding_system_flag, + 1, 1, 0, + 0) + (process) register Lisp_Object process; { /* Ignore the argument and return the value of