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