Improve TTY library detection
[sxemacs] / src / process.c
1 /* Asynchronous subprocess control for SXEmacs.
2    Copyright (C) 1985, 1986, 1987, 1988, 1992, 1993, 1994, 1995, 2003
3    Free Software Foundation, Inc.
4    Copyright (C) 1995 Sun Microsystems, Inc.
5    Copyright (C) 1995, 1996 Ben Wing.
6
7 This file is part of SXEmacs
8
9 SXEmacs is free software: you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation, either version 3 of the License, or
12 (at your option) any later version.
13
14 SXEmacs is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
17 GNU General Public License for more details.
18
19 You should have received a copy of the GNU General Public License
20 along with this program.  If not, see <http://www.gnu.org/licenses/>. */
21
22
23 /* This file has been Mule-ized except for `start-process-internal',
24    `open-network-stream-internal' and `open-multicast-group-internal'. */
25
26 /* This file has been split into process.c and process-unix.c by
27    Kirill M. Katsnelson <kkm@kis.ru>, so please bash him and not
28    the original author(s) */
29
30 #include <config.h>
31
32 #if !defined (NO_SUBPROCESSES)
33
34 /* The entire file is within this conditional */
35
36 #include "lisp.h"
37
38 #include "buffer.h"
39 #include "commands.h"
40 #include "events/events.h"
41 #include "ui/frame.h"
42 #include "hash.h"
43 #include "ui/insdel.h"
44 #include "lstream.h"
45 #include "opaque.h"
46 #include "process.h"
47 #include "procimpl.h"
48 #include "ui/window.h"
49 #ifdef FILE_CODING
50 #include "mule/file-coding.h"
51 #endif
52
53 #include "sysfile.h"
54 #include "sysproc.h"
55 #include "systime.h"
56 #include "syssignal.h"          /* Always include before systty.h */
57 #include "ui/TTY/systty.h"
58 #include "syswait.h"
59
60 #if defined(HAVE_OPENSSL) && defined(OPENSSL_SSL)
61 #include "openssl.h"
62 #endif
63 #include "dynacat.h"
64
65 Lisp_Object Qprocessp, Qprocess_live_p, Qprocess_readable_p;
66
67 /* Process methods */
68 struct process_methods the_process_methods;
69
70 /* a process object is a network connection when its pid field a cons
71    (name of name of port we are connected to . foreign host name) */
72 #ifdef HAVE_SOCKETS
73 /* valid objects to server stream host parameter */
74 Lisp_Object Qip_any, Qlocalhost;
75 #endif
76
77 /* Valid values of process->status_symbol */
78 Lisp_Object Qrun, Qstop;
79 /* Qrun => Qopen, Qexit => Qclosed for "network connection" processes */
80 Lisp_Object Qopen, Qclosed;
81 /* Protocol families */
82 Lisp_Object Qtcp, Qudp;
83
84 #ifdef HAVE_MULTICAST
85 Lisp_Object Qmulticast;         /* Will be used for occasional warnings */
86 #endif
87
88 /* t means use pty, nil means use a pipe,
89    maybe other values to come.  */
90 Lisp_Object Vprocess_connection_type;
91
92 /* Read comments to DEFVAR of this */
93 int windowed_process_io;
94
95 #ifdef PROCESS_IO_BLOCKING
96 /* List of port numbers or port names to set a blocking I/O mode.
97    Nil means set a non-blocking I/O mode [default]. */
98 Lisp_Object network_stream_blocking_port_list;
99 #endif                          /* PROCESS_IO_BLOCKING */
100
101 /* Number of events of change of status of a process.  */
102 volatile int process_tick;
103
104 /* Number of events for which the user or sentinel has been notified.  */
105 static int update_tick;
106
107 /* Nonzero means delete a process right away if it exits.  */
108 int delete_exited_processes;
109
110 /* Hash table which maps USIDs as returned by create_stream_pair_cb to
111    process objects. Processes are not GC-protected through this! */
112 struct hash_table *usid_to_process;
113 Lisp_Object Vusid_to_process;
114
115 /* List of process objects. */
116 Lisp_Object Vprocess_list;
117
118 extern Lisp_Object Vlisp_EXEC_SUFFIXES;
119 Lisp_Object Vnull_device;
120 \f
121 static Lisp_Object mark_process(Lisp_Object object)
122 {
123         Lisp_Process *process = XPROCESS(object);
124         MAYBE_PROCMETH(mark_process_data, (process));
125         mark_object(process->name);
126         mark_object(process->command);
127         mark_object(process->filter);
128         mark_object(process->sentinel);
129         mark_object(process->buffer);
130         mark_object(process->mark);
131         mark_object(process->pid);
132         mark_object(process->pipe_instream);
133         mark_object(process->pipe_outstream);
134 #ifdef FILE_CODING
135         mark_object(process->coding_instream);
136         mark_object(process->coding_outstream);
137 #endif
138         mark_object(process->process_type_data);
139         return process->status_symbol;
140 }
141
142 static void
143 print_process(Lisp_Object object, Lisp_Object printcharfun, int escapeflag)
144 {
145         Lisp_Process *process = XPROCESS(object);
146
147         if (print_readably)
148                 error("printing unreadable object #<process %s>",
149                       XSTRING_DATA(process->name));
150
151         if (!escapeflag) {
152                 print_internal(process->name, printcharfun, 0);
153         } else {
154                 /* int netp = network_connection_p(object); */
155                 int netp = ((process->process_type == PROCESS_TYPE_NETWORK) ||
156                             (process->process_type == PROCESS_TYPE_MULTICAST) ||
157                             (process->process_type == PROCESS_TYPE_SSL) ||
158                             (process->process_type == PROCESS_TYPE_NETWORK_SERVER_LISTEN));
159                 switch (process->process_type) {
160                 case PROCESS_TYPE_NETWORK:
161                         write_c_string(
162                                 GETTEXT("#<network connection "),
163                                 printcharfun);
164                         break;
165                 case PROCESS_TYPE_NETWORK_SERVER_LISTEN:
166                         write_c_string(
167                                 GETTEXT("#<network server accepting connections "),
168                                 printcharfun);
169                         break;
170                 case PROCESS_TYPE_MULTICAST:
171                         write_c_string(
172                                 GETTEXT("#<multicast network connection "),
173                                 printcharfun);
174                         break;
175                 case PROCESS_TYPE_SSL:
176                         write_c_string(
177                                 GETTEXT("#<secure network connection "),
178                                 printcharfun);
179                         break;
180                 case PROCESS_TYPE_PROC:
181                 default:
182                         write_c_string(
183                                 GETTEXT("#<process "),
184                                 printcharfun);
185                         break;
186                 }
187                 print_internal(process->name, printcharfun, 1);
188                 write_c_string((netp ? " " : " pid "), printcharfun);
189                 print_internal(process->pid, printcharfun, 1);
190                 write_c_string(" state:", printcharfun);
191                 print_internal(process->status_symbol, printcharfun, 1);
192                 MAYBE_PROCMETH(print_process_data, (process, printcharfun));
193                 write_c_string(">", printcharfun);
194         }
195 }
196
197 #ifdef HAVE_WINDOW_SYSTEM
198 extern void debug_process_finalization(Lisp_Process * p);
199 #endif                          /* HAVE_WINDOW_SYSTEM */
200
201 static void finalize_process(void *header, int for_disksave)
202 {
203         /* #### this probably needs to be tied into the tty event loop */
204         /* #### when there is one */
205         Lisp_Process *p = (Lisp_Process *) header;
206 #ifdef HAVE_WINDOW_SYSTEM
207         if (!for_disksave) {
208                 debug_process_finalization(p);
209         }
210 #endif                          /* HAVE_WINDOW_SYSTEM */
211
212         if (p->process_data) {
213                 MAYBE_PROCMETH(finalize_process_data, (p, for_disksave));
214                 if (!for_disksave)
215                         xfree(p->process_data);
216         }
217 }
218
219 DEFINE_LRECORD_IMPLEMENTATION("process", process,
220                               mark_process, print_process, finalize_process,
221                               0, 0, 0, Lisp_Process);
222 \f
223 /************************************************************************/
224 /*                       basic process accessors                        */
225 /************************************************************************/
226
227 /* Under FILE_CODING, this function returns low-level streams, connected
228    directly to the child process, rather than en/decoding FILE_CODING
229    streams */
230 void
231 get_process_streams(Lisp_Process * p, Lisp_Object * instr, Lisp_Object * outstr)
232 {
233         assert(p);
234         assert(NILP(p->pipe_instream) || LSTREAMP(p->pipe_instream));
235         assert(NILP(p->pipe_outstream) || LSTREAMP(p->pipe_outstream));
236         *instr = p->pipe_instream;
237         *outstr = p->pipe_outstream;
238 }
239
240 Lisp_Process *get_process_from_usid(USID usid)
241 {
242         const void *vval;
243
244         assert(usid != USID_ERROR && usid != USID_DONTHASH);
245
246         if (gethash((const void *)usid, usid_to_process, &vval)) {
247                 Lisp_Object process;
248                 CVOID_TO_LISP(process, vval);
249                 return XPROCESS(process);
250         } else
251                 return 0;
252 }
253
254 int get_process_selected_p(Lisp_Process * p)
255 {
256         return p->selected;
257 }
258
259 void set_process_selected_p(Lisp_Process * p, int selected_p)
260 {
261         p->selected = !!selected_p;
262 }
263
264 int connected_via_filedesc_p(Lisp_Process * p)
265 {
266         /* In the bad old days of tooltalk this would return non-0 if
267          * there was a tooltalk connection.  So that really means that
268          * in 101 times out of 100 this would return 0 because nobody
269          * ever used tooltalk.  It is possible that one day this might
270          * need some d-bus love. */
271         return 0;
272 }
273
274 #ifdef HAVE_SOCKETS
275 int network_connection_p(Lisp_Object process)
276 {
277         return CONSP(XPROCESS(process)->pid);
278 }
279 #endif
280
281 DEFUN("processp", Fprocessp, 1, 1, 0,   /*
282 Return t if OBJECT is a process.
283 */
284       (object))
285 {
286         return PROCESSP(object) ? Qt : Qnil;
287 }
288
289 DEFUN("process-live-p", Fprocess_live_p, 1, 1, 0,       /*
290 Return t if OBJECT is a process that is alive.
291 */
292       (object))
293 {
294         return PROCESSP(object) && PROCESS_LIVE_P(XPROCESS(object))
295             ? Qt : Qnil;
296 }
297
298 #if 0
299 /* This is a reasonable definition for this new primitive.  Kyle sez:
300
301    "The patch looks OK to me except for the creation and exporting of the
302    Fprocess_readable_p function.  I don't think a new Lisp function
303    should be created until we know something actually needs it.  If
304    we later want to give process-readable-p different semantics it
305    may be hard to do it and stay compatible with what we hastily
306    create today."
307
308    He's right, not yet.  Let's discuss the semantics on XEmacs Design
309    before enabling this.
310 */
311 DEFUN("process-readable-p", Fprocess_readable_p, 1, 1, 0,       /*
312 Return t if OBJECT is a process from which input may be available.
313 */
314       (object))
315 {
316         return PROCESSP(object) && PROCESS_READABLE_P(XPROCESS(object))
317             ? Qt : Qnil;
318 }
319 #endif
320
321 DEFUN("process-list", Fprocess_list, 0, 0, 0,   /*
322 Return a list of all processes.
323 */
324       ())
325 {
326         return Fcopy_sequence(Vprocess_list);
327 }
328
329 DEFUN("get-process", Fget_process, 1, 1, 0,     /*
330 Return the process named PROCESS-NAME (a string), or nil if there is none.
331 PROCESS-NAME may also be a process; if so, the value is that process.
332 */
333       (process_name))
334 {
335         if (PROCESSP(process_name))
336                 return process_name;
337
338         if (!gc_in_progress)
339                 /* this only gets called during GC when emacs is going away as a result
340                    of a signal or crash. */
341                 CHECK_STRING(process_name);
342
343         {
344                 LIST_LOOP_2(process, Vprocess_list)
345                     if (internal_equal
346                         (process_name, XPROCESS(process)->name, 0))
347                         return process;
348         }
349         return Qnil;
350 }
351
352 DEFUN("get-buffer-process", Fget_buffer_process, 1, 1, 0,       /*
353 Return the (or, a) process associated with BUFFER.
354 BUFFER may be a buffer or the name of one.
355 */
356       (buffer))
357 {
358         if (NILP(buffer))
359                 return Qnil;
360         buffer = Fget_buffer(buffer);
361         if (NILP(buffer))
362                 return Qnil;
363
364         {
365                 LIST_LOOP_2(process, Vprocess_list)
366                     if (EQ(XPROCESS(process)->buffer, buffer))
367                         return process;
368         }
369         return Qnil;
370 }
371
372 /* This is how commands for the user decode process arguments.  It
373    accepts a process, a process name, a buffer, a buffer name, or nil.
374    Buffers denote the first process in the buffer, and nil denotes the
375    current buffer.  */
376
377 static Lisp_Object get_process(Lisp_Object name)
378 {
379         Lisp_Object buffer;
380
381 #ifdef I18N3
382         /* #### Look more closely into translating process names. */
383 #endif
384
385         /* This may be called during a GC from process_send_signal() from
386            kill_buffer_processes() if emacs decides to abort(). */
387         if (PROCESSP(name))
388                 return name;
389         else if (STRINGP(name)) {
390                 Lisp_Object object = Fget_process(name);
391                 if (PROCESSP(object))
392                         return object;
393
394                 buffer = Fget_buffer(name);
395                 if (BUFFERP(buffer))
396                         goto have_buffer_object;
397
398                 error("Process %s does not exist", XSTRING_DATA(name));
399         } else if (NILP(name)) {
400                 buffer = Fcurrent_buffer();
401                 goto have_buffer_object;
402         } else if (BUFFERP(name)) {
403                 Lisp_Object process;
404                 buffer = name;
405
406               have_buffer_object:
407                 process = Fget_buffer_process(buffer);
408                 if (PROCESSP(process))
409                         return process;
410
411                 error("Buffer %s has no process",
412                       XSTRING_DATA(XBUFFER(buffer)->name));
413         } else
414                 return get_process(Fsignal(Qwrong_type_argument,
415                                            (list2
416                                             (build_string
417                                              ("process or buffer or nil"),
418                                              name))));
419 }
420
421 DEFUN("process-id", Fprocess_id, 1, 1, 0,       /*
422 Return the process id of PROCESS.
423 This is the pid of the Unix process which PROCESS uses or talks to.
424 For a network connection, this value is a cons of
425 (foreign-network-port . foreign-host-name).
426 */
427       (process))
428 {
429         Lisp_Object pid;
430         CHECK_PROCESS(process);
431
432         pid = XPROCESS(process)->pid;
433         if (network_connection_p(process))
434                 /* return Qnil; */
435                 return Fcons(Fcar(pid), Fcdr(pid));
436         else
437                 return pid;
438 }
439
440 DEFUN("process-name", Fprocess_name, 1, 1, 0,   /*
441 Return the name of PROCESS, as a string.
442 This is the name of the program invoked in PROCESS,
443 possibly modified to make it unique among process names.
444 */
445       (process))
446 {
447         CHECK_PROCESS(process);
448         return XPROCESS(process)->name;
449 }
450
451 DEFUN("process-command", Fprocess_command, 1, 1, 0,     /*
452 Return the command that was executed to start PROCESS.
453 This is a list of strings, the first string being the program executed
454 and the rest of the strings being the arguments given to it.
455 */
456       (process))
457 {
458         CHECK_PROCESS(process);
459         return XPROCESS(process)->command;
460 }
461 \f
462 /************************************************************************/
463 /*                          creating a process                          */
464 /************************************************************************/
465
466 Lisp_Object make_process_internal(Lisp_Object name)
467 {
468         Lisp_Object val, name1;
469         int i;
470         Lisp_Process *p = alloc_lcrecord_type(Lisp_Process, &lrecord_process);
471
472         /* If name is already in use, modify it until it is unused.  */
473         name1 = name;
474         for (i = 1;; i++) {
475                 char suffix[24];
476                 int sz;
477                 Lisp_Object tem = Fget_process(name1);
478                 if (NILP(tem))
479                         break;
480                 sz = snprintf(suffix, sizeof(suffix), "<%d>", i);
481                 assert(sz>=0 && (size_t)sz<sizeof(suffix));
482                 name1 = concat2(name, build_string(suffix));
483         }
484         name = name1;
485         p->name = name;
486
487         p->command = Qnil;
488         p->filter = Qnil;
489         p->sentinel = Qnil;
490         p->buffer = Qnil;
491         p->mark = Fmake_marker();
492         p->pid = Qnil;
493         p->status_symbol = Qrun;
494         p->exit_code = 0;
495         p->core_dumped = 0;
496         p->filter_does_read = 0;
497         p->kill_without_query = 0;
498         p->selected = 0;
499         p->tick = 0;
500         p->update_tick = 0;
501         p->pipe_instream = Qnil;
502         p->pipe_outstream = Qnil;
503 #ifdef FILE_CODING
504         p->coding_instream = Qnil;
505         p->coding_outstream = Qnil;
506 #endif
507         p->process_type = PROCESS_TYPE_PROC;
508         p->process_type_data = Qnil;
509
510         p->process_data = 0;
511         MAYBE_PROCMETH(alloc_process_data, (p));
512
513         XSETPROCESS(val, p);
514
515         Vprocess_list = Fcons(val, Vprocess_list);
516         return val;
517 }
518
519 void init_process_io_handles(Lisp_Process * p, void *in, void *out, int flags)
520 {
521         USID usid = event_stream_create_stream_pair(in, out,
522                                                     &p->pipe_instream,
523                                                     &p->pipe_outstream,
524                                                     flags);
525
526         if (usid == USID_ERROR)
527                 report_file_error("Setting up communication with subprocess",
528                                   Qnil);
529
530         if (usid != USID_DONTHASH) {
531                 Lisp_Object process = Qnil;
532                 XSETPROCESS(process, p);
533                 puthash((const void *)usid, LISP_TO_VOID(process),
534                         usid_to_process);
535         }
536
537         MAYBE_PROCMETH(init_process_io_handles, (p, in, out, flags));
538
539 #ifdef FILE_CODING
540         p->coding_instream = make_decoding_input_stream
541             (XLSTREAM(p->pipe_instream),
542              Fget_coding_system(Vcoding_system_for_read));
543         Lstream_set_character_mode(XLSTREAM(p->coding_instream));
544         p->coding_outstream = make_encoding_output_stream
545             (XLSTREAM(p->pipe_outstream),
546              Fget_coding_system(Vcoding_system_for_write));
547         /* CODE_CNTL (&out_state[outchannel]) |= CC_END; !!####
548            What's going on here? */
549 #endif                          /* FILE_CODING */
550 }
551
552 static void
553 create_process(Lisp_Object process, Lisp_Object * argv, int nargv,
554                Lisp_Object program, Lisp_Object cur_dir)
555 {
556         Lisp_Process *p = XPROCESS(process);
557         int pid;
558
559         /* *_create_process may change status_symbol, if the process
560            is a kind of "fire-and-forget" (no I/O, unwaitable) */
561         p->status_symbol = Qrun;
562         p->exit_code = 0;
563
564         pid = PROCMETH(create_process, (p, argv, nargv, program, cur_dir));
565
566         p->pid = make_int(pid);
567         if (PROCESS_READABLE_P(p))
568                 event_stream_select_process(p);
569 }
570
571 /* This function is the unwind_protect form for Fstart_process_internal.  If
572    PROCESS doesn't have its pid set, then we know someone has signalled
573    an error and the process wasn't started successfully, so we should
574    remove it from the process list.  */
575 static void remove_process(Lisp_Object process);
576 static Lisp_Object start_process_unwind(Lisp_Object process)
577 {
578         /* Was PROCESS started successfully?  */
579         if (EQ(XPROCESS(process)->pid, Qnil))
580                 remove_process(process);
581         return Qnil;
582 }
583
584 DEFUN("start-process-internal", Fstart_process_internal, 3, MANY, 0,    /*
585 Start a program in a subprocess.  Return the process object for it.
586 Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS
587 NAME is name for process.  It is modified if necessary to make it unique.
588 BUFFER is the buffer or (buffer-name) to associate with the process.
589 Process output goes at end of that buffer, unless you specify
590 an output stream or filter function to handle the output.
591 BUFFER may be also nil, meaning that this process is not associated
592 with any buffer
593 Third arg is program file name.  It is searched for as in the shell.
594 Remaining arguments are strings to give program as arguments.
595 If bound, `coding-system-for-read' and `coding-system-for-write' specify
596 the coding-system objects used in input from and output to the process.
597 */
598       (int nargs, Lisp_Object * args))
599 {
600         /* This function can call lisp */
601         /* !!#### This function has not been Mule-ized */
602         Lisp_Object buffer, name, program, process, current_dir;
603         Lisp_Object tem;
604         int i;
605         int speccount = specpdl_depth();
606         struct gcpro gcpro1, gcpro2, gcpro3;
607
608         name = args[0];
609         buffer = args[1];
610         program = args[2];
611         current_dir = Qnil;
612
613         /* Protect against various file handlers doing GCs below. */
614         GCPRO3(buffer, program, current_dir);
615
616         if (!NILP(buffer))
617                 buffer = Fget_buffer_create(buffer);
618
619         CHECK_STRING(name);
620         CHECK_STRING(program);
621         for (i = 3; i < nargs; ++i)
622                 CHECK_STRING(args[i]);
623
624         /* Make sure that the child will be able to chdir to the current
625            buffer's current directory, or its unhandled equivalent.  We
626            can't just have the child check for an error when it does the
627            chdir, since it's in a vfork.
628
629            Note: these assignments and calls are like this in order to insure
630            "caller protects args" GC semantics. */
631         current_dir = current_buffer->directory;
632         current_dir = Funhandled_file_name_directory(current_dir);
633         current_dir = expand_and_dir_to_file(current_dir, Qnil);
634
635 #if 0                           /* This loser breaks ange-ftp */
636         /* dmoore - if you re-enable this code, you have to gcprotect
637            current_buffer through the above calls. */
638         if (NILP(Ffile_accessible_directory_p(current_dir)))
639                 report_file_error("Setting current directory",
640                                   list1(current_buffer->directory));
641 #endif                          /* 0 */
642
643         /* If program file name is not absolute, search our path for it */
644         if (!IS_DIRECTORY_SEP(XSTRING_BYTE(program, 0))
645             && !(XSTRING_LENGTH(program) > 1
646                  && IS_DEVICE_SEP(XSTRING_BYTE(program, 1)))) {
647                 struct gcpro ngcpro1;
648
649                 tem = Qnil;
650                 NGCPRO1(tem);
651                 locate_file(Vexec_path, program, Vlisp_EXEC_SUFFIXES, &tem,
652                             X_OK);
653                 if (NILP(tem))
654                         report_file_error("Searching for program",
655                                           list1(program));
656                 program = Fexpand_file_name(tem, Qnil);
657                 NUNGCPRO;
658         } else {
659                 /* we still need to canonicalize it and ensure it has the proper
660                    ending, e.g. .exe */
661                 struct gcpro ngcpro1;
662
663                 tem = Qnil;
664                 NGCPRO1(tem);
665                 locate_file(list1(build_string("")), program,
666                             Vlisp_EXEC_SUFFIXES, &tem, X_OK);
667                 if (NILP(tem))
668                         report_file_error("Searching for program",
669                                           list1(program));
670                 program = tem;
671                 NUNGCPRO;
672         }
673
674         if (!NILP(Ffile_directory_p(program)))
675                 invalid_operation
676                     ("Specified program for new process is a directory",
677                      program);
678
679         process = make_process_internal(name);
680
681         XPROCESS(process)->buffer = buffer;
682         XPROCESS(process)->command = Flist(nargs - 2, args + 2);
683
684         /* Make the process marker point into the process buffer (if any).  */
685         if (!NILP(buffer))
686                 Fset_marker(XPROCESS(process)->mark,
687                             make_int(BUF_ZV(XBUFFER(buffer))), buffer);
688
689         /* If an error occurs and we can't start the process, we want to
690            remove it from the process list.  This means that each error
691            check in create_process doesn't need to call remove_process
692            itself; it's all taken care of here.  */
693         record_unwind_protect(start_process_unwind, process);
694
695         create_process(process, args + 3, nargs - 3, program, current_dir);
696
697         UNGCPRO;
698         return unbind_to(speccount, process);
699 }
700 \f
701 #ifdef HAVE_SOCKETS
702
703 /* #### The network support is fairly synthetical. What we actually
704    need is a single function, which supports all datagram, stream and
705    packet stream connections, arbitrary protocol families should they
706    be supported by the target system, multicast groups, in both data
707    and control rooted/nonrooted flavors, service quality etc whatever
708    is supported by the underlying network.
709
710    It must accept a property list describing the connection. The current
711    functions must then go to lisp and provide a suitable list for the
712    generalized connection function.
713
714    All modern UNIX other OSs support BSD sockets, and there are many
715    extensions available (Sockets 2 spec).
716
717    A todo is define a consistent set of properties abstracting a
718    network connection.   -kkm
719 */
720
721
722
723 DEFUN("network-process-listener", Fnetwork_process_listener, 1, 1, 0, /*
724 Returns the process that listened and accepted the given
725 network-process. Returns nil if process is closed or was not accepted
726 through a network server stream.
727
728 Args are PROCESS
729
730 PROCESS should be a network-stream process accepted through a network
731 */
732       (process))
733 {
734
735         CHECK_PROCESS(process);
736         return MAYBE_LISP_PROCMETH(network_process_listener, (process));
737 }
738
739
740 /* Listen for a TCP network connection to a given SERVICE.  Treated
741    exactly like a normal process when reading and writing.  Only
742    differences are in status display and process deletion.  A network
743    connection has no PID; you cannot signal it.  All you can do is
744    deactivate and close it via delete-process. You must provide a
745    sentinel. */
746 DEFUN("open-network-server-stream-internal", Fopen_network_server_stream_internal, 4, 8, 0,     /*
747 Returns a process object to represent the listening connection. When a
748 new connection request arrives, it is automatically accepted. A
749 network-stream process is automatically created for that
750 connection. If needed a new buffer is also created. If given the
751 acceptor function is called. If defined filter and sentinel are set
752 for the new connection process .
753
754 Input and output work as for subprocesses; `delete-process' closes it.
755
756 Args are NAME BUFFER HOST SERVICE &optional PROTOCOL ACCEPTOR .
757
758 NAME is name for process.  It is modified if necessary to make it
759 unique.
760
761 BUFFER is the buffer (or buffer-name) to associate with the process.
762  Listening Process output goes at end of that buffer, unless you
763  specify an output stream or filter function to handle the output. No
764  real process output of listening process is expected. However the
765  name of this buffer will be used as a base for generating a new
766  buffer name for the accepted connections.
767  The BUFFER may be also nil, meaning that this process is not
768  associated with any buffer. In this case a filter should be specified
769  otherwise there will be no way to retrieve the process output.
770  BUFFER may also be 'auto in which case a buffer is automatically
771  created for the accepted connection.
772
773 Third arg HOST (a string) is the name of the IP to bind to, or its
774  IP address, If nil or ip_any will bind to all addresses on the
775  machine. When HOST is 'localhost listening connection will listen
776  to connections from the local machine only.
777 Fourth arg SERVICE is name of the service desired, or an integer
778  specifying a port number to connect to.
779 Fifth argument PROTOCOL is a network protocol.  Currently 'tcp
780  (Transmission Control Protocol) and 'udp (User Datagram Protocol) are
781  supported.  When omitted, 'tcp is assumed.
782 Sixt argument ACCEPTOR is a function which will be called upon connection
783  acceptance with the accepted connection process as the single argument.
784 Seventh argument FILTER is a function which will be set as filter for
785  the accepted connections automatically. See `set-process-filter' for
786  more details.
787 Eight argument SENTINEL is a function which will be set as sentinel
788  the accepted connections automatically. see `set-process-sentinel'
789  for more details.
790
791 Output via `process-send-string' and input via buffer or filter (see
792 `set-process-filter') are stream-oriented.  That means UDP datagrams are
793 not guaranteed to be sent and received in discrete packets. (But small
794 datagrams around 500 bytes that are not truncated by `process-send-string'
795 are usually fine.)  Note further that UDP protocol does not guard against
796 lost packets.
797
798 In the ACCEPTOR you can use `network-process-listener' to get the original
799 listen process, and `process-buffer' to retrieve the associated
800 buffers. If sentinels and/or filters are set in the ACCEPTOR they
801 will override the FILTER and SENTINEL args to this function.
802 */
803       (name, buffer, host, service, protocol, acceptor, filter, sentinel))
804 {
805
806         /* !!#### This function has not been Mule-ized */
807         /* This function can GC */
808         Lisp_Object process = Qnil;
809         Lisp_Object bufname = Qnil;
810         struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6, gcpro7, gcpro8, ngcpro1, ngcpro2;
811         void *inch, *outch;
812
813         GCPRO8(name, buffer, host, service, protocol, acceptor, filter, sentinel);
814         CHECK_STRING(name);
815
816         if (NILP(protocol))
817                 protocol = Qtcp;
818         else
819                 CHECK_SYMBOL(protocol);
820
821         if (NILP(host))
822                 host = Qip_any;
823
824         /* Since this code is inside HAVE_SOCKETS, existence of
825            open_network_stream is mandatory */
826         PROCMETH(open_network_server_stream, (name, host, service, protocol,
827                                        &inch, &outch));
828
829         NGCPRO2(process,bufname);
830         if (!NILP(buffer) && !SYMBOLP(buffer)) {
831                 buffer = Fget_buffer_create(buffer);
832                 bufname = Fbuffer_name(buffer);
833         } else if (SYMBOLP(buffer) && !NILP(buffer) && ! EQ(Qauto,buffer) ) {
834                         error("unknown buffer symbol %s",
835                               string_data(symbol_name(XSYMBOL(buffer))));
836                         return Qnil;
837
838         } else {
839                 Lisp_Object args[] = {
840                         build_string("<listen proc:%S host:%S service:%S protocol:%S>"),
841                         name, host, service, protocol
842                 };
843                 bufname = Fformat( 5, args );
844         }
845
846         process = make_process_internal(name);
847
848         XPROCESS(process)->pid = Fcons(service, host);
849         XPROCESS(process)->process_type = PROCESS_TYPE_NETWORK_SERVER_LISTEN;
850         XPROCESS(process)->buffer = buffer;
851         {
852                 /* Just opened a scope because I like to keep definitions close to
853                    usage specially temporary ones... */
854                 Lisp_Object args[] = { acceptor, filter, sentinel, bufname };
855                 XPROCESS(process)->process_type_data = Flist(4,args);
856         }
857         init_process_io_handles(XPROCESS(process), (void *)inch, (void *)outch,
858                                 STREAM_NETWORK_SERVER_CONNECTION);
859
860         event_stream_select_process(XPROCESS(process));
861
862         NUNGCPRO;
863         UNGCPRO;
864         return process;
865 }
866
867
868 /* open a TCP network connection to a given HOST/SERVICE.  Treated
869    exactly like a normal process when reading and writing.  Only
870    differences are in status display and process deletion.  A network
871    connection has no PID; you cannot signal it.  All you can do is
872    deactivate and close it via delete-process */
873
874 DEFUN("open-network-stream-internal", Fopen_network_stream_internal, 4, 5, 0,   /*
875 Open a TCP connection for a service to a host.
876 Return a process object to represent the connection.
877 Input and output work as for subprocesses; `delete-process' closes it.
878
879 NAME is name for process.  It is modified if necessary to make it unique.
880 BUFFER is the buffer (or buffer-name) to associate with the process.
881 Process output goes at end of that buffer, unless you specify
882 an output stream or filter function to handle the output.
883 BUFFER may also be nil, meaning that this process is not associated
884 with any buffer.
885 Third arg HOST (a string) is  the name of the host to connect to,
886 or its IP address.
887 Fourth arg SERVICE is the name of the service desired (a string),
888 or an integer specifying a port number to connect to.
889 Optional fifth arg PROTOCOL is a network protocol.  Currently only 'tcp
890 (Transmission Control Protocol) and 'udp (User Datagram Protocol) are
891 supported.  When omitted, 'tcp is assumed.
892
893 Output via `process-send-string' and input via buffer or filter (see
894 `set-process-filter') are stream-oriented.  That means UDP datagrams are
895 not guaranteed to be sent and received in discrete packets. (But small
896 datagrams around 500 bytes that are not truncated by `process-send-string'
897 are usually fine.)  Note further that the UDP protocol does not guard
898 against lost packets.
899 */
900       (name, buffer, host, service, protocol))
901 {
902         /* !!#### This function has not been Mule-ized */
903         /* This function can GC */
904         Lisp_Object process = Qnil;
905         struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, ngcpro1;
906         void *inch, *outch;
907
908         GCPRO5(name, buffer, host, service, protocol);
909         CHECK_STRING(name);
910
911         if (NILP(protocol))
912                 protocol = Qtcp;
913         else
914                 CHECK_SYMBOL(protocol);
915
916         /* Since this code is inside HAVE_SOCKETS, existence of
917            open_network_stream is mandatory */
918         PROCMETH(open_network_stream, (name, host, service, protocol,
919                                        &inch, &outch));
920
921         if (!NILP(buffer))
922                 buffer = Fget_buffer_create(buffer);
923         process = make_process_internal(name);
924         NGCPRO1(process);
925
926         XPROCESS(process)->pid = Fcons(service, host);
927         XPROCESS(process)->process_type = PROCESS_TYPE_NETWORK;
928         XPROCESS(process)->buffer = buffer;
929         init_process_io_handles(XPROCESS(process), (void *)inch, (void *)outch,
930                                 STREAM_NETWORK_CONNECTION);
931
932         event_stream_select_process(XPROCESS(process));
933
934         NUNGCPRO;
935         UNGCPRO;
936         return process;
937 }
938
939 DEFUN("connect-file-descriptor", Fconnect_file_descriptor, 4, 4, 0, /*
940   Connect to an existing file descriptor.
941 Return a subprocess-object to represent the connection.
942 Input and output work as for subprocesses; `delete-process' closes it.
943 Args are NAME BUFFER INFD OUTFD.
944 NAME is name for process.  It is modified if necessary to make it unique.
945 BUFFER is the buffer (or buffer-name) to associate with the process.
946  Process output goes at end of that buffer, unless you specify
947  an output stream or filter function to handle the output.
948  BUFFER may also be nil, meaning that this process is not associated
949  with any buffer.
950 INFD and OUTFD specify the file descriptors to use for input and
951  output, respectively.
952 */
953       (name, buffer, infd, outfd))
954 {
955         return connect_to_file_descriptor(name, buffer, infd, outfd);
956 }
957
958 #ifdef HAVE_MULTICAST
959
960 DEFUN("open-multicast-group-internal", Fopen_multicast_group_internal, 5, 5, 0, /*
961 Open a multicast connection on the specified dest/port/ttl.
962 Return a process object to represent the connection.
963 Input and output work as for subprocesses; `delete-process' closes it.
964
965 NAME is name for process.  It is modified if necessary to make it unique.
966 BUFFER is the buffer (or buffer-name) to associate with the process.
967 Process output goes at end of that buffer, unless you specify
968 an output stream or filter function to handle the output.
969 BUFFER may also be nil, meaning that this process is not associated
970 with any buffer.
971 Third, fourth and fifth args are the multicast destination group, port and ttl.
972 dest must be an internet address between 224.0.0.0 and 239.255.255.255
973 port is a communication port like in traditional unicast
974 ttl is the time-to-live (15 for site, 63 for region and 127 for world)
975 */
976       (name, buffer, dest, port, ttl))
977 {
978         /* !!#### This function has not been Mule-ized */
979         /* This function can GC */
980         Lisp_Object process = Qnil;
981         struct gcpro gcpro1;
982         void *inch, *outch;
983
984         CHECK_STRING(name);
985
986         /* Since this code is inside HAVE_MULTICAST, existence of
987            open_network_stream is mandatory */
988         PROCMETH(open_multicast_group, (name, dest, port, ttl, &inch, &outch));
989
990         if (!NILP(buffer))
991                 buffer = Fget_buffer_create(buffer);
992
993         process = make_process_internal(name);
994         GCPRO1(process);
995
996         XPROCESS(process)->pid = Fcons(port, dest);
997         XPROCESS(process)->process_type = PROCESS_TYPE_MULTICAST;
998         XPROCESS(process)->buffer = buffer;
999         init_process_io_handles(XPROCESS(process), (void *)inch, (void *)outch,
1000                                 STREAM_NETWORK_CONNECTION);
1001
1002         event_stream_select_process(XPROCESS(process));
1003
1004         UNGCPRO;
1005         return process;
1006 }
1007 #endif                          /* HAVE_MULTICAST */
1008
1009 #endif                          /* HAVE_SOCKETS */
1010
1011 Lisp_Object canonicalize_host_name(Lisp_Object host)
1012 {
1013         return PROCMETH_OR_GIVEN(canonicalize_host_name, (host), host);
1014 }
1015 \f
1016 DEFUN("set-process-window-size", Fset_process_window_size, 3, 3, 0,     /*
1017 Tell PROCESS that it has logical window size HEIGHT and WIDTH.
1018 */
1019       (process, height, width))
1020 {
1021         CHECK_PROCESS(process);
1022         CHECK_NATNUM(height);
1023         CHECK_NATNUM(width);
1024         return
1025             MAYBE_INT_PROCMETH(set_window_size,
1026                                (XPROCESS(process), XINT(height),
1027                                 XINT(width))) <= 0 ? Qnil : Qt;
1028 }
1029 \f
1030 /************************************************************************/
1031 /*                              Process I/O                             */
1032 /************************************************************************/
1033
1034 /* Read pending output from the process channel,
1035    starting with our buffered-ahead character if we have one.
1036    Yield number of characters read.
1037
1038    This function reads at most 1024 bytes.
1039    If you want to read all available subprocess output,
1040    you must call it repeatedly until it returns zero.  */
1041
1042 Charcount read_process_output(Lisp_Object process)
1043 {
1044         /* This function can GC */
1045         Bytecount nbytes, nchars;
1046         Bufbyte chars[1024];
1047         Lisp_Object outstream;
1048         Lisp_Process *p = XPROCESS(process);
1049
1050         /* If there is a lot of output from the subprocess, the loop in
1051            execute_internal_event() might call read_process_output() more
1052            than once.  If the filter that was executed from one of these
1053            calls set the filter to t, we have to stop now.  Return -1 rather
1054            than 0 so execute_internal_event() doesn't close the process.
1055            Really, the loop in execute_internal_event() should check itself
1056            for a process-filter change, like in status_notify(); but the
1057            struct Lisp_Process is not exported outside of this file. */
1058         if (!PROCESS_READABLE_P(p))
1059                 return -1;      /* already closed */
1060
1061         if (!NILP(p->filter) && (p->filter_does_read)) {
1062                 Lisp_Object filter_result;
1063
1064                 /* Some weird FSFmacs crap here with
1065                    Vdeactivate_mark and current_buffer->keymap */
1066                 running_asynch_code = 1;
1067                 filter_result = call2_trapping_errors("Error in process filter",
1068                                                       p->filter, process, Qnil);
1069                 running_asynch_code = 0;
1070                 restore_match_data();
1071                 CHECK_INT(filter_result);
1072                 return XINT(filter_result);
1073         }
1074
1075         switch (p->process_type) {
1076         case PROCESS_TYPE_NETWORK_SERVER_LISTEN:
1077                 /* We must have add a connect... We should accept and call
1078                    the sentinel.. */
1079                 PROCMETH(network_server_accept, (wrap_object(p)));
1080                 nbytes = 0;
1081                 break;
1082         case PROCESS_TYPE_PROC:
1083         case PROCESS_TYPE_NETWORK:
1084         case PROCESS_TYPE_MULTICAST:
1085         case PROCESS_TYPE_SSL:
1086         default:
1087                 nbytes = Lstream_read(XLSTREAM(DATA_INSTREAM(p)),
1088                                       chars, sizeof(chars));
1089                 break;
1090         }
1091
1092         if (nbytes <= 0)
1093                 return nbytes;
1094
1095         nchars = bytecount_to_charcount(chars, nbytes);
1096         outstream = p->filter;
1097         if (!NILP(outstream)) {
1098                 /* We used to bind inhibit-quit to t here, but
1099                    call2_trapping_errors() does that for us. */
1100                 running_asynch_code = 1;
1101                 call2_trapping_errors("Error in process filter",
1102                                       outstream, process, make_string(chars,
1103                                                                       nbytes));
1104                 running_asynch_code = 0;
1105                 restore_match_data();
1106                 return nchars;
1107         }
1108
1109         /* If no filter, write into buffer if it isn't dead.  */
1110         if (!NILP(p->buffer) && BUFFER_LIVE_P(XBUFFER(p->buffer))) {
1111                 Lisp_Object old_read_only = Qnil;
1112                 Bufpos old_point;
1113                 Bufpos old_begv;
1114                 Bufpos old_zv;
1115                 int old_zmacs_region_stays = zmacs_region_stays;
1116                 struct gcpro gcpro1, gcpro2;
1117                 struct buffer *buf = XBUFFER(p->buffer);
1118
1119                 GCPRO2(process, old_read_only);
1120
1121                 old_point = BUF_PT(buf);
1122                 old_begv = BUF_BEGV(buf);
1123                 old_zv = BUF_ZV(buf);
1124                 old_read_only = buf->read_only;
1125                 buf->read_only = Qnil;
1126
1127                 /* Insert new output into buffer
1128                    at the current end-of-output marker,
1129                    thus preserving logical ordering of input and output.  */
1130                 if (XMARKER(p->mark)->buffer)
1131                         BUF_SET_PT(buf,
1132                                    bufpos_clip_to_bounds(old_begv,
1133                                                          marker_position(p->
1134                                                                          mark),
1135                                                          old_zv));
1136                 else
1137                         BUF_SET_PT(buf, old_zv);
1138
1139                 /* If the output marker is outside of the visible region, save
1140                    the restriction and widen.  */
1141                 if (!(BUF_BEGV(buf) <= BUF_PT(buf) &&
1142                       BUF_PT(buf) <= BUF_ZV(buf)))
1143                         Fwiden(p->buffer);
1144
1145                 /* Make sure opoint floats ahead of any new text, just as point
1146                    would.  */
1147                 if (BUF_PT(buf) <= old_point)
1148                         old_point += nchars;
1149
1150                 /* Insert after old_begv, but before old_zv.  */
1151                 if (BUF_PT(buf) < old_begv)
1152                         old_begv += nchars;
1153                 if (BUF_PT(buf) <= old_zv)
1154                         old_zv += nchars;
1155
1156 #if 0
1157                 /* This screws up initial display of the window.  jla */
1158
1159                 /* Insert before markers in case we are inserting where
1160                    the buffer's mark is, and the user's next command is Meta-y.  */
1161                 buffer_insert_raw_string_1(buf, -1, chars,
1162                                            nbytes, INSDEL_BEFORE_MARKERS);
1163 #else
1164                 buffer_insert_raw_string(buf, chars, nbytes);
1165 #endif
1166
1167                 Fset_marker(p->mark, make_int(BUF_PT(buf)), p->buffer);
1168
1169                 MARK_MODELINE_CHANGED;
1170
1171                 /* If the restriction isn't what it should be, set it.  */
1172                 if (old_begv != BUF_BEGV(buf) || old_zv != BUF_ZV(buf)) {
1173                         Fwiden(p->buffer);
1174                         old_begv = bufpos_clip_to_bounds(BUF_BEG(buf),
1175                                                          old_begv, BUF_Z(buf));
1176                         old_zv = bufpos_clip_to_bounds(BUF_BEG(buf),
1177                                                        old_zv, BUF_Z(buf));
1178                         Fnarrow_to_region(make_int(old_begv), make_int(old_zv),
1179                                           p->buffer);
1180                 }
1181
1182                 /* Handling the process output should not deactivate the mark.  */
1183                 zmacs_region_stays = old_zmacs_region_stays;
1184                 buf->read_only = old_read_only;
1185                 old_point = bufpos_clip_to_bounds(BUF_BEGV(buf),
1186                                                   old_point, BUF_ZV(buf));
1187                 BUF_SET_PT(buf, old_point);
1188
1189                 UNGCPRO;
1190         }
1191         return nchars;
1192 }
1193 \f
1194 /* Sending data to subprocess */
1195
1196 /* send some data to process PROCESS.  If NONRELOCATABLE is non-NULL, it
1197    specifies the address of the data.  Otherwise, the data comes from the
1198    object RELOCATABLE (either a string or a buffer).  START and LEN
1199    specify the offset and length of the data to send.
1200
1201    Note that START and LEN are in Bufpos's if RELOCATABLE is a buffer,
1202    and in Bytecounts otherwise. */
1203
1204 void
1205 send_process(Lisp_Object process,
1206              Lisp_Object relocatable, const Bufbyte * nonrelocatable,
1207              int start, int len)
1208 {
1209         /* This function can GC */
1210         struct gcpro gcpro1, gcpro2;
1211         Lisp_Object lstream = Qnil;
1212
1213         GCPRO2(process, lstream);
1214
1215         if (NILP(DATA_OUTSTREAM(XPROCESS(process))))
1216                 signal_simple_error("Process not open for writing", process);
1217
1218         if (nonrelocatable)
1219                 lstream =
1220                     make_fixed_buffer_input_stream(nonrelocatable + start, len);
1221         else if (BUFFERP(relocatable))
1222                 lstream = make_lisp_buffer_input_stream(XBUFFER(relocatable),
1223                                                         start, start + len, 0);
1224         else
1225                 lstream =
1226                     make_lisp_string_input_stream(relocatable, start, len);
1227
1228         PROCMETH(send_process, (process, XLSTREAM(lstream)));
1229
1230         UNGCPRO;
1231         Lstream_delete(XLSTREAM(lstream));
1232 }
1233
1234 DEFUN("process-tty-name", Fprocess_tty_name, 1, 1, 0,   /*
1235 Return the name of the terminal PROCESS uses, or nil if none.
1236 This is the terminal that the process itself reads and writes on,
1237 not the name of the pty that Emacs uses to talk with that terminal.
1238 */
1239       (process))
1240 {
1241         CHECK_PROCESS(process);
1242         return MAYBE_LISP_PROCMETH(get_tty_name, (XPROCESS(process)));
1243 }
1244
1245 DEFUN("set-process-buffer", Fset_process_buffer, 2, 2, 0,       /*
1246 Set buffer associated with PROCESS to BUFFER (a buffer, or nil).
1247 */
1248       (process, buffer))
1249 {
1250         CHECK_PROCESS(process);
1251         if (!NILP(buffer))
1252                 CHECK_BUFFER(buffer);
1253         XPROCESS(process)->buffer = buffer;
1254         return buffer;
1255 }
1256
1257 DEFUN("process-buffer", Fprocess_buffer, 1, 1, 0,       /*
1258 Return the buffer PROCESS is associated with.
1259 Output from PROCESS is inserted in this buffer
1260 unless PROCESS has a filter.
1261 */
1262       (process))
1263 {
1264         CHECK_PROCESS(process);
1265         return XPROCESS(process)->buffer;
1266 }
1267
1268 DEFUN("process-mark", Fprocess_mark, 1, 1, 0,   /*
1269 Return the marker for the end of the last output from PROCESS.
1270 */
1271       (process))
1272 {
1273         CHECK_PROCESS(process);
1274         return XPROCESS(process)->mark;
1275 }
1276
1277 void
1278 set_process_filter(Lisp_Object process, Lisp_Object filter,
1279                    int filter_does_read)
1280 {
1281         CHECK_PROCESS(process);
1282         if (PROCESS_READABLE_P(XPROCESS(process))) {
1283                 if (EQ(filter, Qt))
1284                         event_stream_unselect_process(XPROCESS(process));
1285                 else
1286                         event_stream_select_process(XPROCESS(process));
1287         }
1288
1289         XPROCESS(process)->filter = filter;
1290         XPROCESS(process)->filter_does_read = filter_does_read;
1291 }
1292
1293 DEFUN("set-process-filter", Fset_process_filter, 2, 3, 0,       /*
1294 Give PROCESS the filter function FILTER; nil means no filter.
1295 t means stop accepting output from the process.
1296 When a process has a filter, each time it does output
1297 the entire string of output is passed to the filter.
1298 The filter gets two arguments: the process and the string of output
1299 unless third FILTER-DOES-READ parameter is non-nil.  In that case
1300 output string is nil, and filter must perform reading by itself. It
1301 must return integer value of how much data was read, return 0 if there
1302 is nothing to be read.
1303 If the process has a filter, its buffer is not used for output.
1304 */
1305       (process, filter, filter_does_read))
1306 {
1307         set_process_filter(process, filter, !NILP(filter_does_read));
1308         return filter;
1309 }
1310
1311 DEFUN("process-filter", Fprocess_filter, 1, 1, 0,       /*
1312 Return the filter function of PROCESS; nil if none.
1313 See `set-process-filter' for more info on filter functions.
1314 */
1315       (process))
1316 {
1317         CHECK_PROCESS(process);
1318         return XPROCESS(process)->filter;
1319 }
1320
1321 DEFUN("process-type-data", Fprocess_type_data, 1, 1, 0, /*
1322 Return the type data of PROCESS; `nil' if none.
1323 */
1324       (process))
1325 {
1326         CHECK_PROCESS(process);
1327         return XPROCESS(process)->process_type_data;
1328 }
1329
1330 DEFUN("process-send-region", Fprocess_send_region, 3, 4, 0,     /*
1331 Send current contents of the region between START and END as input to PROCESS.
1332 PROCESS may be a process or the name of a process, or a buffer or the
1333 name of a buffer, in which case the buffer's process is used.  If it
1334 is nil, the current buffer's process is used.
1335 BUFFER specifies the buffer to look in; if nil, the current buffer is used.
1336 If STRING is more than 100 or so characters long, it may be sent in
1337 several chunks.  This may happen even for shorter strings.  Output
1338 from processes can arrive in between chunks.
1339 */
1340       (process, start, end, buffer))
1341 {
1342         /* This function can GC */
1343         Bufpos bstart, bend;
1344         struct buffer *buf = decode_buffer(buffer, 0);
1345
1346         XSETBUFFER(buffer, buf);
1347         process = get_process(process);
1348         get_buffer_range_char(buf, start, end, &bstart, &bend, 0);
1349
1350         send_process(process, buffer, 0, bstart, bend - bstart);
1351         return Qnil;
1352 }
1353
1354 DEFUN("process-send-string", Fprocess_send_string, 2, 4, 0,     /*
1355 Send PROCESS the contents of STRING as input.
1356 PROCESS may be a process or the name of a process, or a buffer or the
1357 name of a buffer, in which case the buffer's process is used.  If it
1358 is nil, the current buffer's process is used.
1359 Optional arguments START and END specify part of STRING; see `substring'.
1360 If STRING is more than 100 or so characters long, it may be sent in
1361 several chunks.  This may happen even for shorter strings.  Output
1362 from processes can arrive in between chunks.
1363 */
1364       (process, string, start, end))
1365 {
1366         /* This function can GC */
1367         Bytecount bstart, bend;
1368
1369         process = get_process(process);
1370         CHECK_STRING(string);
1371         get_string_range_byte(string, start, end, &bstart, &bend,
1372                               GB_HISTORICAL_STRING_BEHAVIOR);
1373
1374         send_process(process, string, 0, bstart, bend - bstart);
1375         return Qnil;
1376 }
1377
1378 #ifdef FILE_CODING
1379
1380 DEFUN("process-input-coding-system", Fprocess_input_coding_system, 1, 1, 0,     /*
1381 Return PROCESS's input coding system.
1382 */
1383       (process))
1384 {
1385         process = get_process(process);
1386         CHECK_READABLE_PROCESS(process);
1387         return
1388             decoding_stream_coding_system(XLSTREAM
1389                                           (XPROCESS(process)->coding_instream));
1390 }
1391
1392 DEFUN("process-output-coding-system", Fprocess_output_coding_system, 1, 1, 0,   /*
1393 Return PROCESS's output coding system.
1394 */
1395       (process))
1396 {
1397         process = get_process(process);
1398         CHECK_LIVE_PROCESS(process);
1399         return
1400             encoding_stream_coding_system(XLSTREAM
1401                                           (XPROCESS(process)->
1402                                            coding_outstream));
1403 }
1404
1405 DEFUN("process-coding-system", Fprocess_coding_system, 1, 1, 0, /*
1406 Return a pair of coding-system for decoding and encoding of PROCESS.
1407 */
1408       (process))
1409 {
1410         process = get_process(process);
1411         CHECK_READABLE_PROCESS(process);
1412         return Fcons(decoding_stream_coding_system
1413                      (XLSTREAM(XPROCESS(process)->coding_instream)),
1414                      encoding_stream_coding_system
1415                      (XLSTREAM(XPROCESS(process)->coding_outstream)));
1416 }
1417
1418 DEFUN("set-process-input-coding-system", Fset_process_input_coding_system, 2, 2, 0,     /*
1419 Set PROCESS's input coding system to CODESYS.
1420 */
1421       (process, codesys))
1422 {
1423         codesys = Fget_coding_system(codesys);
1424         process = get_process(process);
1425         CHECK_READABLE_PROCESS(process);
1426
1427         set_decoding_stream_coding_system
1428             (XLSTREAM(XPROCESS(process)->coding_instream), codesys);
1429         return Qnil;
1430 }
1431
1432 DEFUN("set-process-output-coding-system",
1433       Fset_process_output_coding_system, 2, 2, 0, /*
1434 Set PROCESS's output coding system to CODESYS.
1435 */
1436       (process, codesys))
1437 {
1438         codesys = Fget_coding_system(codesys);
1439         process = get_process(process);
1440         CHECK_LIVE_PROCESS(process);
1441
1442         set_encoding_stream_coding_system
1443             (XLSTREAM(XPROCESS(process)->coding_outstream), codesys);
1444         return Qnil;
1445 }
1446
1447 DEFUN("set-process-coding-system", Fset_process_coding_system, 1, 3, 0, /*
1448 Set coding-systems of PROCESS to DECODING and ENCODING.
1449 DECODING will be used to decode subprocess output and ENCODING to
1450 encode subprocess input.
1451 */
1452       (process, decoding, encoding))
1453 {
1454         if (!NILP(decoding))
1455                 Fset_process_input_coding_system(process, decoding);
1456
1457         if (!NILP(encoding))
1458                 Fset_process_output_coding_system(process, encoding);
1459
1460         return Qnil;
1461 }
1462
1463 #endif                          /* FILE_CODING */
1464 \f
1465 /************************************************************************/
1466 /*                             process status                           */
1467 /************************************************************************/
1468
1469 static Lisp_Object exec_sentinel_unwind(Lisp_Object datum)
1470 {
1471         Lisp_Cons *d = XCONS(datum);
1472         XPROCESS(d->car)->sentinel = d->cdr;
1473         free_cons(d);
1474         return Qnil;
1475 }
1476
1477 static void exec_sentinel(Lisp_Object process, Lisp_Object reason)
1478 {
1479         /* This function can GC */
1480         int speccount = specpdl_depth();
1481         Lisp_Process *p = XPROCESS(process);
1482         Lisp_Object sentinel = p->sentinel;
1483
1484         if (NILP(sentinel))
1485                 return;
1486
1487         /* Some weird FSFmacs crap here with
1488            Vdeactivate_mark and current_buffer->keymap */
1489
1490         /* Zilch the sentinel while it's running, to avoid recursive invocations;
1491            assure that it gets restored no matter how the sentinel exits.  */
1492         p->sentinel = Qnil;
1493         record_unwind_protect(exec_sentinel_unwind,
1494                               noseeum_cons(process, sentinel));
1495         /* We used to bind inhibit-quit to t here, but call2_trapping_errors()
1496            does that for us. */
1497         running_asynch_code = 1;
1498         call2_trapping_errors("Error in process sentinel", sentinel, process,
1499                               reason);
1500         running_asynch_code = 0;
1501         restore_match_data();
1502         unbind_to(speccount, Qnil);
1503 }
1504
1505 DEFUN("set-process-sentinel", Fset_process_sentinel, 2, 2, 0,   /*
1506 Give PROCESS the sentinel SENTINEL; nil for none.
1507 The sentinel is called as a function when the process changes state.
1508 It gets two arguments: the process, and a string describing the change.
1509 */
1510       (process, sentinel))
1511 {
1512         CHECK_PROCESS(process);
1513         XPROCESS(process)->sentinel = sentinel;
1514         return sentinel;
1515 }
1516
1517 DEFUN("process-sentinel", Fprocess_sentinel, 1, 1, 0,   /*
1518 Return the sentinel of PROCESS; nil if none.
1519 See `set-process-sentinel' for more info on sentinels.
1520 */
1521       (process))
1522 {
1523         CHECK_PROCESS(process);
1524         return XPROCESS(process)->sentinel;
1525 }
1526 \f
1527 const char *signal_name(int signum)
1528 {
1529         if (signum >= 0 && signum < NSIG)
1530 #if HAVE_STRSIGNAL
1531                 return (const char *)strsignal(signum);
1532 #elif SXE_SYS_SIGLIST_DECLARED || HAVE_SYS_SIGLIST || SYS_SIGLIST_DECLARED || HAVE_DECL_SYS_SIGLIST
1533                 return (const char *)sys_siglist[signum];
1534 #else
1535                 return (const char *)GETTEXT("unknown signal - missing signal list");
1536 #endif
1537
1538         return (const char *)GETTEXT("unknown signal");
1539 }
1540
1541 void
1542 update_process_status(Lisp_Object p,
1543                       Lisp_Object status_symbol, int exit_code, int core_dumped)
1544 {
1545         XPROCESS(p)->tick++;
1546         process_tick++;
1547         XPROCESS(p)->status_symbol = status_symbol;
1548         XPROCESS(p)->exit_code = exit_code;
1549         XPROCESS(p)->core_dumped = core_dumped;
1550 }
1551
1552 /* Return a string describing a process status list.  */
1553
1554 static Lisp_Object status_message(Lisp_Process * p)
1555 {
1556         Lisp_Object symbol = p->status_symbol;
1557         int code = p->exit_code;
1558         int coredump = p->core_dumped;
1559         Lisp_Object string, string2;
1560
1561         if (EQ(symbol, Qsignal) || EQ(symbol, Qstop)) {
1562                 string = build_string(signal_name(code));
1563                 if (coredump)
1564                         string2 = build_translated_string(" (core dumped)\n");
1565                 else
1566                         string2 = build_string("\n");
1567                 set_string_char(XSTRING(string), 0,
1568                                 DOWNCASE(current_buffer,
1569                                          string_char(XSTRING(string), 0)));
1570                 return concat2(string, string2);
1571         } else if (EQ(symbol, Qexit)) {
1572                 if (code == 0)
1573                         return build_translated_string("finished\n");
1574                 string = Fnumber_to_string(make_int(code));
1575                 if (coredump)
1576                         string2 = build_translated_string(" (core dumped)\n");
1577                 else
1578                         string2 = build_string("\n");
1579                 return
1580                     concat2(build_translated_string
1581                             ("exited abnormally with code "), concat2(string,
1582                                                                       string2));
1583         } else
1584                 return Fcopy_sequence(Fsymbol_name(symbol));
1585 }
1586
1587 /* Tell status_notify() to check for terminated processes.  We do this
1588    because on some systems we sometimes miss SIGCHLD calls. (Not sure
1589    why.) */
1590
1591 void kick_status_notify(void)
1592 {
1593         process_tick++;
1594 }
1595
1596 /* Report all recent events of a change in process status
1597    (either run the sentinel or output a message).
1598    This is done while Emacs is waiting for keyboard input.  */
1599
1600 void status_notify(void)
1601 {
1602         /* This function can GC */
1603         Lisp_Object tail = Qnil;
1604         Lisp_Object symbol = Qnil;
1605         Lisp_Object msg = Qnil;
1606         struct gcpro gcpro1, gcpro2, gcpro3;
1607         /* process_tick is volatile, so we have to remember it now.
1608            Otherwise, we get a race condition if SIGCHLD happens during
1609            this function.
1610
1611            (Actually, this is not the case anymore.  The code to
1612            update the process structures has been moved out of the
1613            SIGCHLD handler.  But for the moment I'm leaving this
1614            stuff in -- it can't hurt.) */
1615         int temp_process_tick;
1616
1617         MAYBE_PROCMETH(reap_exited_processes, ());
1618
1619         temp_process_tick = process_tick;
1620
1621         if (update_tick == temp_process_tick)
1622                 return;
1623
1624         /* We need to gcpro tail; if read_process_output calls a filter
1625            which deletes a process and removes the cons to which tail points
1626            from Vprocess_alist, and then causes a GC, tail is an unprotected
1627            reference.  */
1628         GCPRO3(tail, symbol, msg);
1629
1630         for (tail = Vprocess_list; CONSP(tail); tail = XCDR(tail)) {
1631                 Lisp_Object process = XCAR(tail);
1632                 Lisp_Process *p = XPROCESS(process);
1633                 /* p->tick is also volatile.  Same thing as above applies. */
1634                 int this_process_tick;
1635
1636                 /* #### extra check for terminated processes, in case a SIGCHLD
1637                    got missed (this seems to happen sometimes, I'm not sure why).
1638                  */
1639                 if (INTP(p->pid))
1640                         MAYBE_PROCMETH(update_status_if_terminated, (p));
1641
1642                 this_process_tick = p->tick;
1643                 if (this_process_tick != p->update_tick) {
1644                         p->update_tick = this_process_tick;
1645
1646                         /* If process is still active, read any output that remains.  */
1647                         while (!EQ(p->filter, Qt)
1648                                && read_process_output(process) > 0) ;
1649
1650                         /* Get the text to use for the message.  */
1651                         msg = status_message(p);
1652
1653                         /* If process is terminated, deactivate it or delete it.  */
1654                         symbol = p->status_symbol;
1655
1656                         if (EQ(symbol, Qsignal)
1657                             || EQ(symbol, Qexit)) {
1658                                 if (delete_exited_processes)
1659                                         remove_process(process);
1660                                 else
1661                                         deactivate_process(process);
1662                         }
1663
1664                         /* Now output the message suitably.  */
1665                         if (!NILP(p->sentinel))
1666                                 exec_sentinel(process, msg);
1667                         /* Don't bother with a message in the buffer
1668                            when a process becomes runnable.  */
1669                         else if (!EQ(symbol, Qrun) && !NILP(p->buffer)) {
1670                                 Lisp_Object old_read_only = Qnil;
1671                                 Lisp_Object old = Fcurrent_buffer();
1672                                 Bufpos opoint;
1673                                 struct gcpro ngcpro1, ngcpro2;
1674
1675                                 /* Avoid error if buffer is deleted
1676                                    (probably that's why the process is dead, too) */
1677                                 if (!BUFFER_LIVE_P(XBUFFER(p->buffer)))
1678                                         continue;
1679
1680                                 NGCPRO2(old, old_read_only);
1681                                 Fset_buffer(p->buffer);
1682                                 opoint = BUF_PT(current_buffer);
1683                                 /* Insert new output into buffer
1684                                    at the current end-of-output marker,
1685                                    thus preserving logical ordering of input and output.  */
1686                                 if (XMARKER(p->mark)->buffer)
1687                                         BUF_SET_PT(current_buffer,
1688                                                    marker_position(p->mark));
1689                                 else
1690                                         BUF_SET_PT(current_buffer,
1691                                                    BUF_ZV(current_buffer));
1692                                 if (BUF_PT(current_buffer) <= opoint)
1693                                         opoint +=
1694                                             (string_char_length(XSTRING(msg))
1695                                              +
1696                                              string_char_length(XSTRING
1697                                                                 (p->name))
1698                                              + 10);
1699
1700                                 old_read_only = current_buffer->read_only;
1701                                 current_buffer->read_only = Qnil;
1702                                 buffer_insert_c_string(current_buffer,
1703                                                        "\nProcess ");
1704                                 Finsert(1, &p->name);
1705                                 buffer_insert_c_string(current_buffer, " ");
1706                                 Finsert(1, &msg);
1707                                 current_buffer->read_only = old_read_only;
1708                                 Fset_marker(p->mark,
1709                                             make_int(BUF_PT(current_buffer)),
1710                                             p->buffer);
1711
1712                                 opoint =
1713                                     bufpos_clip_to_bounds(BUF_BEGV
1714                                                           (XBUFFER(p->buffer)),
1715                                                           opoint,
1716                                                           BUF_ZV(XBUFFER
1717                                                                  (p->buffer)));
1718                                 BUF_SET_PT(current_buffer, opoint);
1719                                 Fset_buffer(old);
1720                                 NUNGCPRO;
1721                         }
1722                 }
1723         }                       /* end for */
1724
1725         /* in case buffers use %s in modeline-format */
1726         MARK_MODELINE_CHANGED;
1727         redisplay();
1728
1729         update_tick = temp_process_tick;
1730
1731         UNGCPRO;
1732 }
1733
1734 DEFUN("process-status", Fprocess_status, 1, 1, 0,       /*
1735 Return the status of PROCESS.
1736 This is a symbol, one of these:
1737
1738 run    -- for a process that is running.
1739 stop   -- for a process stopped but continuable.
1740 exit   -- for a process that has exited.
1741 signal -- for a process that has got a fatal signal.
1742 open   -- for a network stream connection that is open.
1743 closed -- for a network stream connection that is closed.
1744 nil    -- if arg is a process name and no such process exists.
1745
1746 PROCESS may be a process, a buffer, the name of a process or buffer, or
1747 nil, indicating the current buffer's process.
1748 */
1749       (process))
1750 {
1751         Lisp_Object status_symbol;
1752
1753         if (STRINGP(process))
1754                 process = Fget_process(process);
1755         else
1756                 process = get_process(process);
1757
1758         if (NILP(process))
1759                 return Qnil;
1760
1761         status_symbol = XPROCESS(process)->status_symbol;
1762         if (network_connection_p(process)) {
1763                 if (EQ(status_symbol, Qrun))
1764                         status_symbol = Qopen;
1765                 else if (EQ(status_symbol, Qexit))
1766                         status_symbol = Qclosed;
1767         }
1768         return status_symbol;
1769 }
1770
1771 DEFUN("process-exit-status", Fprocess_exit_status, 1, 1, 0,     /*
1772 Return the exit status of PROCESS or the signal number that killed it.
1773 If PROCESS has not yet exited or died, return 0.
1774 */
1775       (process))
1776 {
1777         CHECK_PROCESS(process);
1778         return make_int(XPROCESS(process)->exit_code);
1779 }
1780 \f
1781 static int decode_signal(Lisp_Object signal_)
1782 {
1783         if (INTP(signal_))
1784                 return XINT(signal_);
1785         else {
1786                 Bufbyte *name;
1787
1788                 CHECK_SYMBOL(signal_);
1789                 name = string_data(XSYMBOL(signal_)->name);
1790
1791 #define handle_signal(sym) do {                         \
1792         if (!strcmp ((const char *) name, #sym))        \
1793           return sym;                                   \
1794       } while (0)
1795
1796                 handle_signal(SIGINT);  /* ANSI */
1797                 handle_signal(SIGILL);  /* ANSI */
1798                 handle_signal(SIGABRT); /* ANSI */
1799                 handle_signal(SIGFPE);  /* ANSI */
1800                 handle_signal(SIGSEGV); /* ANSI */
1801                 handle_signal(SIGTERM); /* ANSI */
1802
1803 #ifdef SIGHUP
1804                 handle_signal(SIGHUP);  /* POSIX */
1805 #endif
1806 #ifdef SIGQUIT
1807                 handle_signal(SIGQUIT); /* POSIX */
1808 #endif
1809 #ifdef SIGTRAP
1810                 handle_signal(SIGTRAP); /* POSIX */
1811 #endif
1812 #ifdef SIGKILL
1813                 handle_signal(SIGKILL); /* POSIX */
1814 #endif
1815 #ifdef SIGUSR1
1816                 handle_signal(SIGUSR1); /* POSIX */
1817 #endif
1818 #ifdef SIGUSR2
1819                 handle_signal(SIGUSR2); /* POSIX */
1820 #endif
1821 #ifdef SIGPIPE
1822                 handle_signal(SIGPIPE); /* POSIX */
1823 #endif
1824 #ifdef SIGALRM
1825                 handle_signal(SIGALRM); /* POSIX */
1826 #endif
1827 #ifdef SIGCHLD
1828                 handle_signal(SIGCHLD); /* POSIX */
1829 #endif
1830 #ifdef SIGCONT
1831                 handle_signal(SIGCONT); /* POSIX */
1832 #endif
1833 #ifdef SIGSTOP
1834                 handle_signal(SIGSTOP); /* POSIX */
1835 #endif
1836 #ifdef SIGTSTP
1837                 handle_signal(SIGTSTP); /* POSIX */
1838 #endif
1839 #ifdef SIGTTIN
1840                 handle_signal(SIGTTIN); /* POSIX */
1841 #endif
1842 #ifdef SIGTTOU
1843                 handle_signal(SIGTTOU); /* POSIX */
1844 #endif
1845
1846 #ifdef SIGBUS
1847                 handle_signal(SIGBUS);  /* XPG5 */
1848 #endif
1849 #ifdef SIGPOLL
1850                 handle_signal(SIGPOLL); /* XPG5 */
1851 #endif
1852 #ifdef SIGPROF
1853                 handle_signal(SIGPROF); /* XPG5 */
1854 #endif
1855 #ifdef SIGSYS
1856                 handle_signal(SIGSYS);  /* XPG5 */
1857 #endif
1858 #ifdef SIGURG
1859                 handle_signal(SIGURG);  /* XPG5 */
1860 #endif
1861 #ifdef SIGXCPU
1862                 handle_signal(SIGXCPU); /* XPG5 */
1863 #endif
1864 #ifdef SIGXFSZ
1865                 handle_signal(SIGXFSZ); /* XPG5 */
1866 #endif
1867 #ifdef SIGVTALRM
1868                 handle_signal(SIGVTALRM);       /* XPG5 */
1869 #endif
1870
1871 #ifdef SIGIO
1872                 handle_signal(SIGIO);   /* BSD 4.2 */
1873 #endif
1874 #ifdef SIGWINCH
1875                 handle_signal(SIGWINCH);        /* BSD 4.3 */
1876 #endif
1877
1878 #ifdef SIGEMT
1879                 handle_signal(SIGEMT);
1880 #endif
1881 #ifdef SIGINFO
1882                 handle_signal(SIGINFO);
1883 #endif
1884 #ifdef SIGHWE
1885                 handle_signal(SIGHWE);
1886 #endif
1887 #ifdef SIGPRE
1888                 handle_signal(SIGPRE);
1889 #endif
1890 #ifdef SIGUME
1891                 handle_signal(SIGUME);
1892 #endif
1893 #ifdef SIGDLK
1894                 handle_signal(SIGDLK);
1895 #endif
1896 #ifdef SIGCPULIM
1897                 handle_signal(SIGCPULIM);
1898 #endif
1899 #ifdef SIGIOT
1900                 handle_signal(SIGIOT);
1901 #endif
1902 #ifdef SIGLOST
1903                 handle_signal(SIGLOST);
1904 #endif
1905 #ifdef SIGSTKFLT
1906                 handle_signal(SIGSTKFLT);
1907 #endif
1908 #ifdef SIGUNUSED
1909                 handle_signal(SIGUNUSED);
1910 #endif
1911 #ifdef SIGDANGER
1912                 handle_signal(SIGDANGER);       /* AIX */
1913 #endif
1914 #ifdef SIGMSG
1915                 handle_signal(SIGMSG);
1916 #endif
1917 #ifdef SIGSOUND
1918                 handle_signal(SIGSOUND);
1919 #endif
1920 #ifdef SIGRETRACT
1921                 handle_signal(SIGRETRACT);
1922 #endif
1923 #ifdef SIGGRANT
1924                 handle_signal(SIGGRANT);
1925 #endif
1926 #ifdef SIGPWR
1927                 handle_signal(SIGPWR);
1928 #endif
1929
1930 #undef handle_signal
1931
1932                 error("Undefined signal name %s", name);
1933                 return 0;       /* Unreached */
1934         }
1935 }
1936
1937 /* Send signal number SIGNO to PROCESS.
1938    CURRENT-GROUP non-nil means send signal to the current
1939    foreground process group of the process's controlling terminal rather
1940    than to the process's own process group.
1941    This is used for various commands in shell mode.
1942    If NOMSG is zero, insert signal-announcements into process's buffers
1943    right away.
1944
1945    If we can, we try to signal PROCESS by sending control characters
1946    down the pty.  This allows us to signal inferiors who have changed
1947    their uid, for which kill() would return an EPERM error, or to
1948    processes running on another computer through a remote login.  */
1949
1950 static void
1951 process_send_signal(Lisp_Object process, int signo,
1952                     int current_group, int nomsg)
1953 {
1954         /* This function can GC */
1955         process = get_process(process);
1956
1957         if (network_connection_p(process))
1958                 error("Network connection %s is not a subprocess",
1959                       XSTRING_DATA(XPROCESS(process)->name));
1960         CHECK_LIVE_PROCESS(process);
1961
1962         MAYBE_PROCMETH(kill_child_process,
1963                        (process, signo, current_group, nomsg));
1964 }
1965
1966 DEFUN("process-send-signal", Fprocess_send_signal, 1, 3, 0,     /*
1967 Send signal SIGNAL to process PROCESS.
1968 SIGNAL may be an integer, or a symbol naming a signal, like `SIGSEGV'.
1969 PROCESS may be a process, a buffer, the name of a process or buffer, or
1970 nil, indicating the current buffer's process.
1971 Third arg CURRENT-GROUP non-nil means send signal to the current
1972 foreground process group of the process's controlling terminal rather
1973 than to the process's own process group.
1974 If the process is a shell that supports job control, this means
1975 send the signal to the current subjob rather than the shell.
1976 */
1977       (signal_, process, current_group))
1978 {
1979         /* This function can GC */
1980         process_send_signal(process, decode_signal(signal_),
1981                             !NILP(current_group), 0);
1982         return process;
1983 }
1984
1985 DEFUN("interrupt-process", Finterrupt_process, 0, 2, 0, /*
1986 Interrupt process PROCESS.
1987 See function `process-send-signal' for more details on usage.
1988 */
1989       (process, current_group))
1990 {
1991         /* This function can GC */
1992         process_send_signal(process, SIGINT, !NILP(current_group), 0);
1993         return process;
1994 }
1995
1996 DEFUN("kill-process", Fkill_process, 0, 2, 0,   /*
1997 Kill process PROCESS.
1998 See function `process-send-signal' for more details on usage.
1999 */
2000       (process, current_group))
2001 {
2002         /* This function can GC */
2003 #ifdef SIGKILL
2004         process_send_signal(process, SIGKILL, !NILP(current_group), 0);
2005 #else
2006         error("kill-process: Not supported on this system");
2007 #endif
2008         return process;
2009 }
2010
2011 DEFUN("quit-process", Fquit_process, 0, 2, 0,   /*
2012 Send QUIT signal to process PROCESS.
2013 See function `process-send-signal' for more details on usage.
2014 */
2015       (process, current_group))
2016 {
2017         /* This function can GC */
2018 #ifdef SIGQUIT
2019         process_send_signal(process, SIGQUIT, !NILP(current_group), 0);
2020 #else
2021         error("quit-process: Not supported on this system");
2022 #endif
2023         return process;
2024 }
2025
2026 DEFUN("stop-process", Fstop_process, 0, 2, 0,   /*
2027 Stop process PROCESS.
2028 See function `process-send-signal' for more details on usage.
2029 */
2030       (process, current_group))
2031 {
2032         /* This function can GC */
2033 #ifdef SIGTSTP
2034         process_send_signal(process, SIGTSTP, !NILP(current_group), 0);
2035 #else
2036         error("stop-process: Not supported on this system");
2037 #endif
2038         return process;
2039 }
2040
2041 DEFUN("continue-process", Fcontinue_process, 0, 2, 0,   /*
2042 Continue process PROCESS.
2043 See function `process-send-signal' for more details on usage.
2044 */
2045       (process, current_group))
2046 {
2047         /* This function can GC */
2048 #ifdef SIGCONT
2049         process_send_signal(process, SIGCONT, !NILP(current_group), 0);
2050 #else
2051         error("continue-process: Not supported on this system");
2052 #endif
2053         return process;
2054 }
2055
2056 DEFUN("signal-process", Fsignal_process, 2, 2, "nProcess number: \nnSignal code: ",     /*
2057 Send the process with process id PID the signal with code SIGNAL.
2058 PID must be an integer.  The process need not be a child of this Emacs.
2059 SIGNAL may be an integer, or a symbol naming a signal, like `SIGSEGV'.
2060 */
2061       (pid, signal_))
2062 {
2063         CHECK_INT(pid);
2064
2065         return make_int(PROCMETH_OR_GIVEN(kill_process_by_pid,
2066                                           (XINT(pid), decode_signal(signal_)),
2067                                           -1));
2068 }
2069
2070 DEFUN("process-send-eof", Fprocess_send_eof, 0, 1, 0,   /*
2071 Make PROCESS see end-of-file in its input.
2072 PROCESS may be a process, a buffer, the name of a process or buffer, or
2073 nil, indicating the current buffer's process.
2074 If PROCESS is a network connection, or is a process communicating
2075 through a pipe (as opposed to a pty), then you cannot send any more
2076 text to PROCESS after you call this function.
2077 */
2078       (process))
2079 {
2080         /* This function can GC */
2081         process = get_process(process);
2082
2083         /* Make sure the process is really alive.  */
2084         if (!EQ(XPROCESS(process)->status_symbol, Qrun))
2085                 error("Process %s not running",
2086                       XSTRING_DATA(XPROCESS(process)->name));
2087
2088         if (!MAYBE_INT_PROCMETH(process_send_eof, (process))) {
2089                 if (!NILP(DATA_OUTSTREAM(XPROCESS(process)))) {
2090                         Lstream_close(XLSTREAM
2091                                       (DATA_OUTSTREAM(XPROCESS(process))));
2092                         event_stream_delete_stream_pair(Qnil,
2093                                                         XPROCESS(process)->
2094                                                         pipe_outstream);
2095                         XPROCESS(process)->pipe_outstream = Qnil;
2096 #ifdef FILE_CODING
2097                         XPROCESS(process)->coding_outstream = Qnil;
2098 #endif
2099                 }
2100         }
2101
2102         return process;
2103 }
2104 \f
2105 /************************************************************************/
2106 /*                          deleting a process                          */
2107 /************************************************************************/
2108
2109 void deactivate_process(Lisp_Object process)
2110 {
2111         Lisp_Process *p = XPROCESS(process);
2112         USID usid;
2113
2114         /* It's possible that we got as far in the process-creation
2115            process as creating the descriptors but didn't get so
2116            far as selecting the process for input.  In this
2117            case, p->pid is nil: p->pid is set at the same time that
2118            the process is selected for input. */
2119         /* #### The comment does not look correct. event_stream_unselect_process
2120            is guarded by process->selected, so this is not a problem. - kkm */
2121         /* Must call this before setting the streams to nil */
2122         event_stream_unselect_process(p);
2123
2124         if (!NILP(DATA_OUTSTREAM(p)))
2125                 Lstream_close(XLSTREAM(DATA_OUTSTREAM(p)));
2126         if (!NILP(DATA_INSTREAM(p)))
2127                 Lstream_close(XLSTREAM(DATA_INSTREAM(p)));
2128
2129         /* Provide minimal implementation for deactivate_process
2130            if there's no process-specific one */
2131         if (HAS_PROCMETH_P(deactivate_process))
2132                 usid = PROCMETH(deactivate_process, (p));
2133         else
2134                 usid = event_stream_delete_stream_pair(p->pipe_instream,
2135                                                        p->pipe_outstream);
2136
2137         if (usid != USID_DONTHASH)
2138                 remhash((const void *)usid, usid_to_process);
2139
2140         p->pipe_instream = Qnil;
2141         p->pipe_outstream = Qnil;
2142 #ifdef FILE_CODING
2143         p->coding_instream = Qnil;
2144         p->coding_outstream = Qnil;
2145 #endif
2146 }
2147
2148 static void remove_process(Lisp_Object process)
2149 {
2150         Vprocess_list = delq_no_quit(process, Vprocess_list);
2151         Fset_marker(XPROCESS(process)->mark, Qnil, Qnil);
2152
2153         deactivate_process(process);
2154 }
2155
2156 DEFUN("delete-process", Fdelete_process, 1, 1, 0,       /*
2157 Delete PROCESS: kill it and forget about it immediately.
2158 PROCESS may be a process or the name of one, or a buffer name.
2159 */
2160       (process))
2161 {
2162         /* This function can GC */
2163         Lisp_Process *p;
2164         process = get_process(process);
2165         p = XPROCESS(process);
2166         if (network_connection_p(process)) {
2167                 p->status_symbol = Qexit;
2168                 p->exit_code = 0;
2169                 p->core_dumped = 0;
2170                 p->tick++;
2171                 process_tick++;
2172         } else if (PROCESS_LIVE_P(p)) {
2173                 Fkill_process(process, Qnil);
2174                 /* Do this now, since remove_process will make sigchld_handler do nothing.  */
2175                 p->status_symbol = Qsignal;
2176                 p->exit_code = SIGKILL;
2177                 p->core_dumped = 0;
2178                 p->tick++;
2179                 process_tick++;
2180                 status_notify();
2181         }
2182         remove_process(process);
2183         return Qnil;
2184 }
2185
2186 /* Kill all processes associated with `buffer'.
2187  If `buffer' is nil, kill all processes  */
2188
2189 void kill_buffer_processes(Lisp_Object buffer)
2190 {
2191         LIST_LOOP_2(process, Vprocess_list)
2192             if ((NILP(buffer) || EQ(XPROCESS(process)->buffer, buffer))) {
2193                 if (network_connection_p(process))
2194                         Fdelete_process(process);
2195                 else if (PROCESS_LIVE_P(XPROCESS(process)))
2196                         process_send_signal(process, SIGHUP, 0, 1);
2197         }
2198 }
2199
2200 DEFUN("process-kill-without-query", Fprocess_kill_without_query, 1, 2, 0,       /*
2201 Say no query needed if PROCESS is running when Emacs is exited.
2202 Optional second argument if non-nil says to require a query.
2203 Value is t if a query was formerly required.
2204 */
2205       (process, require_query_p))
2206 {
2207         int tem;
2208
2209         CHECK_PROCESS(process);
2210         tem = XPROCESS(process)->kill_without_query;
2211         XPROCESS(process)->kill_without_query = NILP(require_query_p);
2212
2213         return tem ? Qnil : Qt;
2214 }
2215
2216 DEFUN("process-kill-without-query-p", Fprocess_kill_without_query_p, 1, 1, 0,   /*
2217 Return t if PROCESS will be killed without query when emacs is exited.
2218 */
2219       (process))
2220 {
2221         CHECK_PROCESS(process);
2222         return XPROCESS(process)->kill_without_query ? Qt : Qnil;
2223 }
2224 \f
2225 static void
2226 mark_usid_to_process(Lisp_Object obj)
2227 {
2228         struct hash_table *ht = get_dynacat(obj);
2229         chentry *e;
2230         chentry *limit;
2231
2232         if (ht->zero_set) {
2233                 mark_object((Lisp_Object)ht->zero_entry);
2234         }
2235
2236         for (e = ht->harray, limit = e + ht->size; e < limit; e++) {
2237                 if (e->key)
2238                         mark_object((Lisp_Object)e->contents);
2239         }
2240 }
2241
2242 /* This is not named init_process in order to avoid a conflict with NS 3.3 */
2243 void init_sxemacs_process(void)
2244 {
2245         MAYBE_PROCMETH(init_process, ());
2246
2247         Vprocess_list = Qnil;
2248
2249         if (usid_to_process) {
2250                 clrhash(usid_to_process);
2251                 return;
2252         } else {
2253                 usid_to_process = make_hash_table(32);
2254                 Vusid_to_process = make_dynacat(usid_to_process);
2255                 set_dynacat_marker(Vusid_to_process, mark_usid_to_process);
2256         }
2257 }
2258
2259 void syms_of_process(void)
2260 {
2261         INIT_LRECORD_IMPLEMENTATION(process);
2262
2263         defsymbol(&Qprocessp, "processp");
2264         defsymbol(&Qprocess_live_p, "process-live-p");
2265 #if 0
2266         /* see comment at Fprocess_readable_p */
2267         defsymbol(&Qprocess_readable_p, "process-readable-p");
2268 #endif
2269         defsymbol(&Qrun, "run");
2270         defsymbol(&Qstop, "stop");
2271         defsymbol(&Qopen, "open");
2272         defsymbol(&Qclosed, "closed");
2273
2274         defsymbol(&Qtcp, "tcp");
2275         defsymbol(&Qudp, "udp");
2276
2277 #ifdef HAVE_MULTICAST
2278         defsymbol(&Qmulticast, "multicast");    /* Used for occasional warnings */
2279 #endif
2280
2281         DEFSUBR(Fprocessp);
2282         DEFSUBR(Fprocess_live_p);
2283 #if 0
2284         /* see comment at Fprocess_readable_p */
2285         DEFSUBR(Fprocess_readable_p);
2286 #endif
2287         DEFSUBR(Fget_process);
2288         DEFSUBR(Fget_buffer_process);
2289         DEFSUBR(Fdelete_process);
2290         DEFSUBR(Fprocess_status);
2291         DEFSUBR(Fprocess_exit_status);
2292         DEFSUBR(Fprocess_id);
2293         DEFSUBR(Fprocess_name);
2294         DEFSUBR(Fprocess_tty_name);
2295         DEFSUBR(Fprocess_command);
2296         DEFSUBR(Fset_process_buffer);
2297         DEFSUBR(Fprocess_buffer);
2298         DEFSUBR(Fprocess_mark);
2299         DEFSUBR(Fset_process_filter);
2300         DEFSUBR(Fprocess_filter);
2301         DEFSUBR(Fprocess_type_data);
2302         DEFSUBR(Fset_process_window_size);
2303         DEFSUBR(Fset_process_sentinel);
2304         DEFSUBR(Fprocess_sentinel);
2305         DEFSUBR(Fprocess_kill_without_query);
2306         DEFSUBR(Fprocess_kill_without_query_p);
2307         DEFSUBR(Fprocess_list);
2308         DEFSUBR(Fstart_process_internal);
2309 #ifdef HAVE_SOCKETS
2310         defsymbol(&Qip_any, "ip_any");
2311         defsymbol(&Qlocalhost, "localhost");
2312         DEFSUBR(Fopen_network_stream_internal);
2313         DEFSUBR(Fopen_network_server_stream_internal);
2314         DEFSUBR(Fnetwork_process_listener);
2315 #ifdef HAVE_MULTICAST
2316         DEFSUBR(Fopen_multicast_group_internal);
2317 #endif                          /* HAVE_MULTICAST */
2318 #endif                          /* HAVE_SOCKETS */
2319         DEFSUBR(Fconnect_file_descriptor);
2320         DEFSUBR(Fprocess_send_region);
2321         DEFSUBR(Fprocess_send_string);
2322         DEFSUBR(Fprocess_send_signal);
2323         DEFSUBR(Finterrupt_process);
2324         DEFSUBR(Fkill_process);
2325         DEFSUBR(Fquit_process);
2326         DEFSUBR(Fstop_process);
2327         DEFSUBR(Fcontinue_process);
2328         DEFSUBR(Fprocess_send_eof);
2329         DEFSUBR(Fsignal_process);
2330 /*  DEFSUBR (Fprocess_connection); */
2331 #ifdef FILE_CODING
2332         DEFSUBR(Fprocess_input_coding_system);
2333         DEFSUBR(Fprocess_output_coding_system);
2334         DEFSUBR(Fset_process_input_coding_system);
2335         DEFSUBR(Fset_process_output_coding_system);
2336         DEFSUBR(Fprocess_coding_system);
2337         DEFSUBR(Fset_process_coding_system);
2338 #endif                          /* FILE_CODING */
2339 }
2340
2341 void vars_of_process(void)
2342 {
2343         Fprovide(intern("subprocesses"));
2344 #ifdef HAVE_SOCKETS
2345         Fprovide(intern("network-streams"));
2346 #ifdef HAVE_MULTICAST
2347         Fprovide(intern("multicast"));
2348 #endif                          /* HAVE_MULTICAST */
2349 #endif                          /* HAVE_SOCKETS */
2350         staticpro(&Vprocess_list);
2351         staticpro(&Vusid_to_process);
2352
2353         DEFVAR_BOOL("delete-exited-processes", &delete_exited_processes /*
2354 *Non-nil means delete processes immediately when they exit.
2355 nil means don't delete them until `list-processes' is run.
2356                                                                          */ );
2357
2358         delete_exited_processes = 1;
2359
2360         DEFVAR_CONST_LISP("null-device", &Vnull_device  /*
2361 Name of the null device, which differs from system to system.
2362 The null device is a filename that acts as a sink for arbitrary amounts of
2363 data, which is discarded, or as a source for a zero-length file.
2364 It is available on all the systems that we currently support, but with
2365 different names (typically either `/dev/null' or `nul').
2366
2367 Note that there is also a /dev/zero on most modern Unix versions,
2368 which acts like /dev/null when used as a sink, but as a source it
2369 sends a non-ending stream of zero bytes.  It's used most often along
2370 with memory-mapping.  We don't provide a Lisp variable for this
2371 because the operations needing this are lower level than what ELisp
2372 programs typically do.
2373                                                          */ );
2374         Vnull_device = build_string(NULL_DEVICE);
2375
2376         DEFVAR_LISP("process-connection-type", &Vprocess_connection_type        /*
2377 Control type of device used to communicate with subprocesses.
2378 Values are nil to use a pipe, or t or `pty' to use a pty.
2379 The value has no effect if the system has no ptys or if all ptys are busy:
2380 then a pipe is used in any case.
2381 The value takes effect when `start-process' is called.
2382                                                                                  */ );
2383         Vprocess_connection_type = Qt;
2384
2385         DEFVAR_BOOL("windowed-process-io", &windowed_process_io /*
2386 Enables input/output on standard handles of a windowed process.
2387 When this variable is nil (the default), SXEmacs does not attempt to read
2388 standard output handle of a windowed process. Instead, the process is
2389 immediately marked as exited immediately upon successful launching. This is
2390 done because normal windowed processes do not use standard I/O, as they are
2391 not connected to any console.
2392
2393 When launching a specially crafted windowed process, which expects to be
2394 launched by SXEmacs, or by other program which pipes its standard input and
2395 output, this variable must be set to non-nil, in which case SXEmacs will
2396 treat this process just like a console process.
2397
2398 NOTE: You should never set this variable, only bind it.
2399
2400 Only Windows processes can be "windowed" or "console". This variable has no
2401 effect on UNIX processes, because all UNIX processes are "console".
2402                                                                  */ );
2403         windowed_process_io = 0;
2404
2405 #ifdef PROCESS_IO_BLOCKING
2406         DEFVAR_LISP("network-stream-blocking-port-list", &network_stream_blocking_port_list     /*
2407 List of port numbers or port names to set a blocking I/O mode with connection.
2408 Nil value means to set a default(non-blocking) I/O mode.
2409 The value takes effect when `open-network-stream-internal' is called.
2410                                                                                                  */ );
2411         network_stream_blocking_port_list = Qnil;
2412 #endif                          /* PROCESS_IO_BLOCKING */
2413 }
2414
2415 #endif                          /* not NO_SUBPROCESSES */