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