4.3BSD - /usr/src/new/emacs/src/process.c

   1: /* Asynchronous subprocess control for GNU Emacs.
   2:    Copyright (C) 1985 Richard M. Stallman.
   3: 
   4: This file is part of GNU Emacs.
   5: 
   6: GNU Emacs is distributed in the hope that it will be useful,
   7: but WITHOUT ANY WARRANTY.  No author or distributor
   8: accepts responsibility to anyone for the consequences of using it
   9: or for whether it serves any particular purpose or works at all,
  10: unless he says so in writing.  Refer to the GNU Emacs General Public
  11: License for full details.
  12: 
  13: Everyone is granted permission to copy, modify and redistribute
  14: GNU Emacs, but only under the conditions described in the
  15: GNU Emacs General Public License.   A copy of this license is
  16: supposed to have been given to you along with GNU Emacs so you
  17: can know your rights and responsibilities.  It should be in a
  18: file named COPYING.  Among other things, the copyright notice
  19: and this notice must be preserved on all copies.  */
  20: 
  21: 
  22: #include <signal.h>
  23: 
  24: #include "config.h"
  25: 
  26: #ifdef subprocesses
  27: /* The entire file is within this conditional */
  28: 
  29: #include <stdio.h>
  30: #include <errno.h>
  31: #include <setjmp.h>
  32: #include <sys/types.h>      /* some typedefs are used in sys/file.h */
  33: #include <sys/file.h>
  34: #include <sys/stat.h>
  35: #ifdef BSD
  36: #include <sys/ioctl.h>
  37: #endif /* BSD */
  38: #ifdef USG
  39: #include <termio.h>
  40: #include <fcntl.h>
  41: #endif /* USG */
  42: 
  43: #ifdef HAVE_TIMEVAL
  44: #if defined (USG) && !defined (UNIPLUS)
  45: #include <time.h>
  46: #else
  47: #include <sys/time.h>
  48: #endif
  49: #endif /* HAVE_TIMEVAL */
  50: 
  51: #if defined (HPUX) && defined (HAVE_PTYS)
  52: #include <sys/ptyio.h>
  53: #endif
  54: 
  55: #undef NULL
  56: #include "lisp.h"
  57: #include "window.h"
  58: #include "buffer.h"
  59: #include "process.h"
  60: #include "termhooks.h"
  61: 
  62: /* Define SIGCHLD as an alias for SIGCLD.  There are many conditionals
  63:    testing SIGCHLD.  */
  64: 
  65: #if !defined (SIGCHLD) && defined (SIGCLD)
  66: #define SIGCHLD SIGCLD
  67: #endif /* SIGCLD */
  68: 
  69: /* Define the structure that the wait system call stores.
  70:    On many systems, there is a structure defined for this.
  71:    But on vanilla-ish USG systems there is not.  */
  72: 
  73: #if !defined (BSD) && !defined (UNIPLUS) && !defined (STRIDE)
  74: #define WAITTYPE int
  75: #define WIFSTOPPED(w) ((w&0377) == 0177)
  76: #define WIFSIGNALED(w) ((w&0377) != 0177 && (w&~0377) == 0)
  77: #define WIFEXITED(w) ((w&0377) == 0)
  78: #define WRETCODE(w) (w >> 8)
  79: #define WSTOPSIG(w) (w >> 8)
  80: #define WCOREDUMP(w) ((w&0200) != 0)
  81: #define WTERMSIG(w) (w & 0377)
  82: #else
  83: #ifdef BSD4_1
  84: #include <wait.h>
  85: #else
  86: #include <sys/wait.h>
  87: #endif /* not BSD 4.1 */
  88: #define WAITTYPE union wait
  89: #define WRETCODE(w) w.w_retcode
  90: #define WSTOPSIG(w) w.w_stopsig
  91: #define WCOREDUMP(w) w.w_coredump
  92: #define WTERMSIG(w) w.w_termsig
  93: #endif
  94: 
  95: extern errno;
  96: extern sys_nerr;
  97: extern char *sys_errlist[];
  98: 
  99: #ifndef BSD4_1
 100: extern char *sys_siglist[];
 101: #else
 102: char *sys_siglist[] =
 103:   {
 104:     "bum signal!!",
 105:     "hangup",
 106:     "interrupt",
 107:     "quit",
 108:     "illegal instruction",
 109:     "trace trap",
 110:     "iot instruction",
 111:     "emt instruction",
 112:     "floating point exception",
 113:     "kill",
 114:     "bus error",
 115:     "segmentation violation",
 116:     "bad argument to system call",
 117:     "write on a pipe with no one to read it",
 118:     "alarm clock",
 119:     "software termination signal from kill",
 120:     "status signal",
 121:     "sendable stop signal not from tty",
 122:     "stop signal from tty",
 123:     "continue a stopped process",
 124:     "child status has changed",
 125:     "background read attempted from control tty",
 126:     "background write attempted from control tty",
 127:     "input record available at control tty",
 128:     "exceeded CPU time limit",
 129:     "exceeded file size limit"
 130:     };
 131: #endif
 132: 
 133: #ifdef vipc
 134: 
 135: #include "vipc.h"
 136: extern int comm_server;
 137: extern int net_listen_address;
 138: #endif vipc
 139: 
 140: 
 141: #ifdef SKTPAIR
 142: #include <sys/socket.h>
 143: #endif /* SKTPAIR */
 144: 
 145: int  child_changed;     /* Flag when a child process has ceased
 146: 				   to be */
 147: 
 148: /* Mask of bits indicating the descriptors that we wait for input on */
 149: 
 150: int input_wait_mask;
 151: 
 152: int delete_exited_processes;
 153: 
 154: #define MAXDESC 32
 155: 
 156: /* Indexed by descriptor, gives the process (if any) for that descriptor */
 157: Lisp_Object chan_process[MAXDESC];
 158: 
 159: /* Alist of elements (NAME . PROCESS) */
 160: Lisp_Object Vprocess_alist;
 161: 
 162: Lisp_Object Qprocessp;
 163: 
 164: Lisp_Object get_process ();
 165: 
 166: /* Buffered-ahead input char from process, indexed by channel.
 167:    -1 means empty (no char is buffered).
 168:    Used on sys V where the only way to tell if there is any
 169:    output from the process is to read at least one char.
 170:    Always -1 on systems that support FIONREAD.  */
 171: 
 172: int proc_buffered_char[MAXDESC];
 173: 
 174: #ifdef HAVE_PTYS
 175: 
 176: /* Open an available pty, putting descriptor in *ptyv,
 177:   and return the file name of the pty.  Return 0 if none available.  */
 178: 
 179: char ptyname[24];
 180: 
 181: char *
 182: pty (ptyv)
 183:      int *ptyv;
 184: {
 185:   struct stat stb;
 186:   register c, i;
 187: 
 188:   for (c = FIRST_PTY_LETTER; c <= 'z'; c++)
 189:     for (i = 0; i < 16; i++)
 190:       {
 191: #ifdef HPUX
 192:     sprintf (ptyname, "/dev/ptym/pty%c%x", c, i);
 193: #else
 194:     sprintf (ptyname, "/dev/pty%c%x", c, i);
 195: #endif /* not HPUX */
 196:     if (stat (ptyname, &stb) < 0)
 197:       return 0;
 198: 
 199:     *ptyv = open (ptyname, O_RDWR | O_NDELAY, 0);
 200:     if (*ptyv >= 0)
 201:       {
 202:         /* check to make certain that both sides are available
 203: 	       this avoids a nasty yet stupid bug in rlogins */
 204:         int x;
 205: #ifdef HPUX
 206:             sprintf (ptyname, "/dev/pty/tty%c%x", c, i);
 207: #else
 208:             sprintf (ptyname, "/dev/tty%c%x", c, i);
 209: #endif /* not HPUX */
 210: #ifndef UNIPLUS
 211:         x = open (ptyname, O_RDWR | O_NDELAY, 0);
 212:         if (x < 0)
 213:           {
 214:         close (*ptyv);
 215:         continue;
 216:           }
 217:         close(x);
 218: #endif /* not UNIPLUS */
 219:         /*
 220: 		* If the following statement is included,
 221: 		* then a 0 length record is EOT, but no other
 222: 		* control characters can be sent down the pty
 223: 		* (e.g., ^S/^Q, ^O, etc.).  If it is not
 224: 		* included, then sending ^D down the pty-pipe
 225: 		* makes a pretty good EOF.
 226: 		*/
 227: /*	      ioctl( *ptyv, TIOCREMOTE, &on );	/* for EOT */
 228: /* this is said to be unecessary, and to be harmful in 4.3.  */
 229: /*	    ioctl (*ptyv, FIONBIO, &on);  */
 230:         return ptyname;
 231:       }
 232:       }
 233:   return 0;
 234: }
 235: 
 236: #endif /* HAVE_PTYS */
 237: 
 238: Lisp_Object
 239: make_process (name)
 240:      Lisp_Object name;
 241: {
 242:   Lisp_Object val, tem, name1;
 243:   register struct Lisp_Process *p;
 244:   char suffix[10];
 245:   register int i;
 246: 
 247:   val = Fmake_vector (make_number ((sizeof (struct Lisp_Process)
 248:                     - sizeof (int) - sizeof (struct Lisp_Vector *))
 249:                    / sizeof (Lisp_Object)),
 250:               Qnil);
 251:   XSETTYPE (val, Lisp_Process);
 252: 
 253:   p = XPROCESS (val);
 254:   XFASTINT (p->infd) = 0;
 255:   XFASTINT (p->outfd) = 0;
 256:   XFASTINT (p->pid) = 0;
 257:   XFASTINT (p->flags) = 0;
 258:   XFASTINT (p->reason) = 0;
 259:   p->mark = Fmake_marker ();
 260: 
 261:   /* If name is already in use, modify it until it is unused.  */
 262: 
 263:   name1 = name;
 264:   for (i = 1; ; i++)
 265:     {
 266:       tem = Fget_process (name1);
 267:       if (NULL (tem)) break;
 268:       sprintf (suffix, "<%d>", i);
 269:       name1 = concat2 (name, build_string (suffix));
 270:     }
 271:   name = name1;
 272:   p->name = name;
 273:   Vprocess_alist = Fcons (Fcons (name, val), Vprocess_alist);
 274:   return val;
 275: }
 276: 
 277: remove_process (proc)
 278:      Lisp_Object proc;
 279: {
 280:   Lisp_Object pair;
 281: 
 282:   pair = Frassq (proc, Vprocess_alist);
 283:   Vprocess_alist = Fdelq (pair, Vprocess_alist);
 284:   Fset_marker (XPROCESS (proc)->mark, Qnil, Qnil);
 285: 
 286:   deactivate_process (proc);
 287: }
 288: 
 289: DEFUN ("processp", Fprocessp, Sprocessp, 1, 1, 0,
 290:   "Return t if OBJECT is a process.")
 291:   (obj)
 292:      Lisp_Object obj;
 293: {
 294:   return XTYPE (obj) == Lisp_Process ? Qt : Qnil;
 295: }
 296: 
 297: DEFUN ("get-process", Fget_process, Sget_process, 1, 1, 0,
 298:   "Return the process named NAME, or nil if there is none.")
 299:   (name)
 300:      Lisp_Object name;
 301: {
 302:   if (XTYPE (name) == Lisp_Process)
 303:     return name;
 304:   CHECK_STRING (name, 0);
 305:   return Fcdr (Fassoc (name, Vprocess_alist));
 306: }
 307: 
 308: DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0,
 309:   "Return the (or, a) process associated with BUFFER.\n\
 310: BUFFER may be a buffer or the name of one.")
 311:   (name)
 312:      Lisp_Object name;
 313: {
 314:   Lisp_Object buf, tail, proc;
 315: 
 316:   if (NULL (name)) return Qnil;
 317:   buf = Fget_buffer (name);
 318:   if (NULL (buf)) return Qnil;
 319: 
 320:   for (tail = Vprocess_alist; !NULL (tail); tail = Fcdr (tail))
 321:     {
 322:       proc = Fcdr (Fcar (tail));
 323:       if (XTYPE (proc) == Lisp_Process && EQ (XPROCESS (proc)->buffer, buf))
 324:     return proc;
 325:     }
 326:   return Qnil;
 327: }
 328: 
 329: /* This is how commands for the user decode process arguments */
 330: 
 331: Lisp_Object
 332: get_process (name)
 333:      Lisp_Object name;
 334: {
 335:   Lisp_Object proc;
 336:   if (NULL (name))
 337:     proc = Fget_buffer_process (Fcurrent_buffer ());
 338:   else
 339:     {
 340:       proc = Fget_process (name);
 341:       if (NULL (proc))
 342:     proc = Fget_buffer_process (Fget_buffer (name));
 343:     }
 344: 
 345:   if (!NULL (proc))
 346:     return proc;
 347: 
 348:   if (NULL (name))
 349:     error ("Current buffer has no process");
 350:   else
 351:     error ("Process %s does not exist", XSTRING (name)->data);
 352:   /* NOTREACHED */
 353: }
 354: 
 355: DEFUN ("delete-process", Fdelete_process, Sdelete_process, 1, 1, 0,
 356:   "Delete PROCESS: kill it and forget about it immediately.\n\
 357: PROCESS may be a process or the name of one, or a buffer name.")
 358:   (proc)
 359:      Lisp_Object proc;
 360: {
 361:   proc = get_process (proc);
 362:   if (XFASTINT (XPROCESS (proc)->infd))
 363:     Fkill_process (proc, Qnil);
 364:   remove_process (proc);
 365:   return Qnil;
 366: }
 367: 
 368: DEFUN ("process-status", Fprocess_status, Sprocess_status, 1, 1, 0,
 369:   "Return the status of PROCESS: a symbol, one of these:\n\
 370: run  -- for a process that is running.\n\
 371: stop -- for a process stopped but continuable.\n\
 372: exit -- for a process that has exited.\n\
 373: signal -- for a process that has got a fatal signal.\n\
 374: command -- for a command channel opened to Emacs by another process.\n\
 375: external -- for an i/o channel opened to Emacs by another process.\n\
 376: nil -- if arg is a process name and no such process exists.")
 377:   (proc)
 378:      Lisp_Object proc;
 379: {
 380:   register struct Lisp_Process *p;
 381:   proc = Fget_process (proc);
 382:   if (NULL (proc))
 383:     return proc;
 384:   p = XPROCESS (proc);
 385: 
 386:   switch (XFASTINT (p->flags) & PROC_STATUS)
 387:     {
 388:     case RUNNING:
 389:       if (!NULL (p->childp))
 390:     return intern ("run");
 391:       else if (!NULL (p->command_channel_p))
 392:     return intern ("command");
 393:       return intern ("external");
 394: 
 395:     case EXITED:
 396:       return intern ("exit");
 397: 
 398:     case SIGNALED:
 399:       return intern ("signal");
 400: 
 401:     case STOPPED:
 402:       return intern ("stop");
 403:     }
 404: 
 405:   /* NOTREACHED */
 406: }
 407: 
 408: DEFUN ("process-id", Fprocess_id, Sprocess_id, 1, 1, 0,
 409:   "Return the process id of PROCESS.\n\
 410: This is the pid of the Unix process which PROCESS uses or talks to.")
 411:   (proc)
 412:      Lisp_Object proc;
 413: {
 414:   CHECK_PROCESS (proc, 0);
 415:   return XPROCESS (proc)->pid;
 416: }
 417: 
 418: DEFUN ("process-name", Fprocess_name, Sprocess_name, 1, 1, 0,
 419:   "Return the name of PROCESS, as a string.\n\
 420: This is the name of the program invoked in PROCESS,\n\
 421: possibly modified to make it unique among process names.")
 422:   (proc)
 423:      Lisp_Object proc;
 424: {
 425:   CHECK_PROCESS (proc, 0);
 426:   return XPROCESS (proc)->name;
 427: }
 428: 
 429: DEFUN ("process-command", Fprocess_command, Sprocess_command, 1, 1, 0,
 430:   "Return the command that was executed to start PROCESS.\n\
 431: This is a list of strings, the first string being the program executed\n\
 432: and the rest of the strings being the arguments given to it.\n\
 433: For a non-child channel, this is nil.")
 434:   (proc)
 435:      Lisp_Object proc;
 436: {
 437:   CHECK_PROCESS (proc, 0);
 438:   return XPROCESS (proc)->command;
 439: }
 440: 
 441: DEFUN ("set-process-buffer", Fset_process_buffer, Sset_process_buffer,
 442:   2, 2, 0,
 443:   "Set buffer associated with PROCESS to BUFFER (a buffer, or nil).")
 444:   (proc, buffer)
 445:      Lisp_Object proc, buffer;
 446: {
 447:   CHECK_PROCESS (proc, 0);
 448:   if (!NULL (buffer))
 449:     CHECK_BUFFER (buffer, 1);
 450:   XPROCESS (proc)->buffer = buffer;
 451:   return buffer;
 452: }
 453: 
 454: DEFUN ("process-buffer", Fprocess_buffer, Sprocess_buffer,
 455:   1, 1, 0,
 456:   "Return the buffer PROCESS is associated with.\n\
 457: Output from PROCESS is inserted in this buffer\n\
 458: unless PROCESS has a filter.")
 459:   (proc)
 460:      Lisp_Object proc;
 461: {
 462:   CHECK_PROCESS (proc, 0);
 463:   return XPROCESS (proc)->buffer;
 464: }
 465: 
 466: DEFUN ("process-mark", Fprocess_mark, Sprocess_mark,
 467:   1, 1, 0,
 468:   "Return the marker for the end of the last output from PROCESS.")
 469:   (proc)
 470:      Lisp_Object proc;
 471: {
 472:   CHECK_PROCESS (proc, 0);
 473:   return XPROCESS (proc)->mark;
 474: }
 475: 
 476: DEFUN ("set-process-filter", Fset_process_filter, Sset_process_filter,
 477:   2, 2, 0,
 478:   "Give PROCESS the filter function FILTER; nil means no filter.\n\
 479: When a process has a filter, each time it does output\n\
 480: the entire string of output is passed to the filter.\n\
 481: The filter gets two arguments: the process and the string of output.\n\
 482: If the process has a filter, its buffer is not used for output.")
 483:   (proc, filter)
 484:      Lisp_Object proc, filter;
 485: {
 486:   CHECK_PROCESS (proc, 0);
 487:   XPROCESS (proc)->filter = filter;
 488:   return filter;
 489: }
 490: 
 491: DEFUN ("process-filter", Fprocess_filter, Sprocess_filter,
 492:   1, 1, 0,
 493:   "Returns the filter function of PROCESS; nil if none.\n\
 494: See set-process-filter for more info on filter functions.")
 495:   (proc)
 496:      Lisp_Object proc;
 497: {
 498:   CHECK_PROCESS (proc, 0);
 499:   return XPROCESS (proc)->filter;
 500: }
 501: 
 502: DEFUN ("set-process-sentinel", Fset_process_sentinel, Sset_process_sentinel,
 503:   2, 2, 0,
 504:   "Give PROCESS the sentinel SENTINEL; nil for none.\n\
 505: The sentinel is called as a function when the process changes state.\n\
 506: It gets two arguments: the process, and a string describing the change.")
 507:   (proc, sentinel)
 508:      Lisp_Object proc, sentinel;
 509: {
 510:   CHECK_PROCESS (proc, 0);
 511:   XPROCESS (proc)->sentinel = sentinel;
 512:   return sentinel;
 513: }
 514: 
 515: DEFUN ("process-sentinel", Fprocess_sentinel, Sprocess_sentinel,
 516:   1, 1, 0,
 517:   "Return the sentinel of PROCESS; nil if none.\n\
 518: See set-process-sentinel for more info on sentinels.")
 519:   (proc)
 520:      Lisp_Object proc;
 521: {
 522:   CHECK_PROCESS (proc, 0);
 523:   return XPROCESS (proc)->sentinel;
 524: }
 525: 
 526: DEFUN ("process-kill-without-query", Fprocess_kill_without_query,
 527:   Sprocess_kill_without_query, 1, 1, 0,
 528:   "Say no query needed if this process is running when Emacs is exited.")
 529:   (proc)
 530:      Lisp_Object proc;
 531: {
 532:   CHECK_PROCESS (proc, 0);
 533:   XPROCESS (proc)->kill_without_query = Qt;
 534:   return Qt;
 535: }
 536: 
 537: Lisp_Object
 538: list_processes_1 ()
 539: {
 540:   Lisp_Object tail, proc, minspace, tem, tem1;
 541:   register struct buffer *old = bf_cur;
 542:   register struct Lisp_Process *p;
 543:   register int state;
 544:   char tembuf[10];
 545: 
 546:   XFASTINT (minspace) = 1;
 547: 
 548:   SetBfp (XBUFFER (Vstandard_output));
 549:   Fbuffer_flush_undo (Vstandard_output);
 550: 
 551:   bf_cur->truncate_lines = Qt;
 552: 
 553:   write_string ("\
 554: Proc         Status   Buffer         Command\n\
 555: ----         ------   ------         -------\n", -1);
 556: 
 557:   for (tail = Vprocess_alist; !NULL (tail); tail = Fcdr (tail))
 558:     {
 559:       proc = Fcdr (Fcar (tail));
 560:       p = XPROCESS (proc);
 561:       if (NULL (p->childp))
 562:     continue;
 563: 
 564:       Finsert (1, &p->name);
 565:       Findent_to (make_number (13), minspace);
 566: 
 567:       state = XFASTINT (p->flags) & PROC_STATUS;
 568:       switch (state)
 569:     {
 570:     case RUNNING:
 571:       write_string ("Run", -1);
 572:       break;
 573: 
 574:     case STOPPED:
 575:       write_string ("Stop", -1);
 576:       break;
 577: 
 578:     case EXITED:
 579:       write_string ("Exit", -1);
 580:       if (XFASTINT (p->reason))
 581:         {
 582:           sprintf (tembuf, " %d", XFASTINT (p->reason));
 583:           write_string (tembuf, -1);
 584:         }
 585:       remove_process (proc);
 586:       break;
 587: 
 588:     case SIGNALED:
 589:       if (XFASTINT (p->reason) < NSIG)
 590:         write_string (sys_siglist [XFASTINT (p->reason)], -1);
 591:       else
 592:         write_string ("Signal", -1);
 593:       remove_process (proc);
 594:     }
 595: 
 596:       Findent_to (make_number (22), minspace);
 597:       if (NULL (p->buffer))
 598:     InsStr ("(none)");
 599:       else if (NULL (XBUFFER (p->buffer)->name))
 600:     InsStr ("(Killed)");
 601:       else
 602:     Finsert (1, &XBUFFER (p->buffer)->name);
 603: 
 604:       Findent_to (make_number (37), minspace);
 605: 
 606:       tem = p->command;
 607:       while (1)
 608:     {
 609:       tem1 = Fcar (tem);
 610:       Finsert (1, &tem1);
 611:       tem = Fcdr (tem);
 612:       if (NULL (tem))
 613:         break;
 614:       InsStr (" ");
 615:     }
 616: 
 617:       InsStr ("\n");
 618:     }
 619: 
 620:   SetBfp (old);
 621:   return Qnil;
 622: }
 623: 
 624: DEFUN ("list-processes", Flist_processes, Slist_processes, 0, 0, "",
 625:   "Display a list of all processes.\n\
 626: \(Any processes listed as Exited or Signaled are actually eliminated\n\
 627: after the listing is made.)")
 628:   ()
 629: {
 630:   internal_with_output_to_temp_buffer ("*Process List*",
 631:                        list_processes_1, Qnil);
 632:   return Qnil;
 633: }
 634: 
 635: DEFUN ("start-process", Fstart_process, Sstart_process, 3, MANY, 0,
 636:   "Start a program in a subprocess.  Return the process object for it.\n\
 637: First arg is name for process.  It is modified if nec to make it unique.\n\
 638: Second arg is buffer to associate with the process (or buffer name).\n\
 639:  Process output goes at end of that buffer, unless you specify\n\
 640:  an output stream or filter function to handle the output.\n\
 641: Third arg is program file name.  It is searched for as in the shell.\n\
 642: Remaining arguments are strings to give program as arguments.")
 643:   (nargs, args)
 644:      int nargs;
 645:      Lisp_Object *args;
 646: {
 647:   Lisp_Object buffer, name, program, proc, tem;
 648:   register unsigned char **new_argv;
 649:   register int i;
 650: 
 651:   name = args[0];
 652:   CHECK_STRING (name, 0);
 653: 
 654:   buffer = args[1];
 655:   program = args[2];
 656: 
 657:   CHECK_STRING (program, 2);
 658: 
 659:   new_argv = (unsigned char **) alloca ((nargs - 1) * sizeof (char *));
 660: 
 661:   for (i = 3; i < nargs; i++)
 662:     {
 663:       tem = args[i];
 664:       CHECK_STRING (tem, i);
 665:       new_argv[i - 2] = XSTRING (tem)->data;
 666:     }
 667:   new_argv[i - 2] = 0;
 668:   new_argv[0] = XSTRING (program)->data;
 669: 
 670:   /* If program file name is not absolute, search our path for it */
 671:   if (new_argv[0][0] != '/')
 672:     {
 673:       tem = Qnil;
 674:       openp (Vexec_path, program, "", &tem, 1);
 675:       if (NULL (tem))
 676:     report_file_error ("Searching for program", Fcons (program, Qnil));
 677:       new_argv[0] = XSTRING (tem)->data;
 678:     }
 679: 
 680:   if (!NULL (buffer))
 681:     buffer = Fget_buffer_create (buffer);
 682:   proc = make_process (name);
 683: 
 684:   XPROCESS (proc)->childp = Qt;
 685:   XPROCESS (proc)->command_channel_p = Qnil;
 686:   XPROCESS (proc)->buffer = buffer;
 687:   XPROCESS (proc)->sentinel = Qnil;
 688:   XPROCESS (proc)->filter = Qnil;
 689:   XPROCESS (proc)->command = Flist (nargs - 2, args + 2);
 690: 
 691:   create_process (proc, new_argv);
 692: 
 693:   return proc;
 694: }
 695: 
 696: create_process_1 (signo)
 697:      int signo;
 698: {
 699: #ifdef USG
 700:   /* USG systems forget handlers when they are used;
 701:      must reestablish each time */
 702:   signal (signo, create_process_1);
 703: #endif /* USG */
 704: }
 705: 
 706: create_process (process, new_argv)
 707:      Lisp_Object process;
 708:      char **new_argv;
 709: {
 710:   int pid, inchannel, outchannel, forkin, forkout;
 711:   int sv[2];
 712:   int (*sigchld)();
 713: 
 714: #ifdef HAVE_PTYS
 715:   char  *ptyname;
 716: 
 717:   ptyname = pty (&inchannel);
 718:   outchannel = inchannel;
 719:   if (ptyname)
 720:     {
 721:       forkout = forkin = open (ptyname, O_RDWR, 0);
 722:       if (forkin < 0)
 723:     report_file_error ("Opening pty", Qnil);
 724:     }
 725:   else
 726: #endif /* HAVE_PTYS */
 727: #ifdef SKTPAIR
 728:     {
 729:       if (socketpair (AF_UNIX, SOCK_STREAM, 0, sv) < 0)
 730:     report_file_error ("Opening socketpair", Qnil);
 731:       outchannel = inchannel = sv[0];
 732:       forkout = forkin = sv[1];
 733:     }
 734: #else /* not SKTPAIR */
 735:     {
 736:       pipe (sv);
 737:       inchannel = sv[0];
 738:       forkout = sv[1];
 739:       pipe (sv);
 740:       outchannel = sv[1];
 741:       forkin = sv[0];
 742:     }
 743: #endif /* not SKTPAIR */
 744: 
 745: #ifdef FIOCLEX
 746:   ioctl (inchannel, FIOCLEX, 0);
 747:   ioctl (outchannel, FIOCLEX, 0);
 748: #endif
 749: 
 750: /* Stride people say it's a mystery why this is needed
 751:    as well as the O_NDELAY, but that it fails without this.  */
 752: #ifdef STRIDE
 753:   {
 754:     int one = 1;
 755:     ioctl (inchannel, FIONBIO, &one);
 756:   }
 757: #endif
 758: 
 759: #ifdef O_NDELAY
 760:   fcntl (inchannel, F_SETFL, O_NDELAY);
 761: #endif
 762: 
 763:   chan_process[inchannel] = process;
 764:   XFASTINT (XPROCESS (process)->infd) = inchannel;
 765:   XFASTINT (XPROCESS (process)->outfd) = outchannel;
 766:   XFASTINT (XPROCESS (process)->flags) = RUNNING;
 767: 
 768:   input_wait_mask |= ChannelMask (inchannel);
 769: 
 770:   /* Delay interrupts until we have a chance to store
 771:      the new fork's pid in its process structure */
 772: #ifdef SIGCHLD
 773: #ifdef BSD4_1
 774:   sighold (SIGCHLD);
 775: #else /* not BSD4_1 */
 776: #if defined (BSD) || defined (UNIPLUS)
 777:   sigsetmask (1 << (SIGCHLD - 1));
 778: #else /* ordinary USG */
 779:   sigchld = signal (SIGCHLD, SIG_DFL);
 780: #endif /* ordinary USG */
 781: #endif /* not BSD4_1 */
 782: #endif /* SIGCHLD */
 783: 
 784:   pid = vfork ();
 785:   if (pid == 0)
 786:     {
 787:       int xforkin = forkin;
 788:       int xforkout = forkout;
 789: #ifdef HAVE_PTYS
 790: #ifdef TIOCNOTTY
 791:       /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
 792: 	 can do TIOCSPGRP only to the process's controlling tty.
 793: 	 We must make the pty terminal the controlling tty of the child.  */
 794:       if (ptyname)
 795:     {
 796:       /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
 797: 	     I can't test it since I don't have 4.3.  */
 798:       int j = open ("/dev/tty", O_RDWR, 0);
 799:       ioctl (j, TIOCNOTTY, 0);
 800:           close (j);
 801: 
 802: #ifndef UNIPLUS
 803:       /* I wonder if close (open (ptyname, ...)) would work?  */
 804:       close (xforkin);
 805:           xforkout = xforkin = open (ptyname, O_RDWR, 0);
 806: 
 807:           if (xforkin < 0)
 808:         abort ();
 809: #endif /* not UNIPLUS */
 810:         }
 811: #endif /* TIOCNOTTY */
 812: #endif /* HAVE_PTYS */
 813:       child_setup (xforkin, xforkout, xforkout, new_argv);
 814:     }
 815: 
 816:   /* If the subfork execv fails, and it exits,
 817:      this close hangs.  I don't know why.
 818:      So have an interrupt jar it loose.  */
 819:   signal (SIGALRM, create_process_1);
 820:   alarm (1);
 821:   close (forkin);
 822:   alarm (0);
 823:   if (forkin != forkout)
 824:     close (forkout);
 825: 
 826:   if (pid < 0)
 827:     {
 828:       remove_process (process);
 829:       report_file_error ("Doing vfork", Qnil);
 830:     }
 831: 
 832:   XFASTINT (XPROCESS (process)->pid) = pid;
 833: 
 834: #ifdef SIGCHLD
 835: #ifdef BSD4_1
 836:   sigrelse (SIGCHLD);
 837: #else /* not BSD4_1 */
 838: #if defined (BSD) || defined (UNIPLUS)
 839:   sigsetmask (0);
 840: #else /* ordinary USG */
 841:   signal (SIGCHLD, sigchld);
 842: #endif /* ordinary USG */
 843: #endif /* not BSD4_1 */
 844: #endif /* SIGCHLD */
 845: }
 846: 
 847: deactivate_process (proc)
 848:      Lisp_Object proc;
 849: {
 850:   register int inchannel, outchannel;
 851:   register struct Lisp_Process *p = XPROCESS (proc);
 852: 
 853:   inchannel = XFASTINT (p->infd);
 854:   outchannel = XFASTINT (p->outfd);
 855: 
 856:   if (inchannel)
 857:     {
 858:       /* Beware SIGCHLD hereabouts. */
 859:       flush_pending_output (inchannel);
 860:       close (inchannel);
 861:       if (outchannel  &&  outchannel != inchannel)
 862:     close (outchannel);
 863: 
 864:       XFASTINT (p->infd) = 0;
 865:       XFASTINT (p->outfd) = 0;
 866:       chan_process[inchannel] = Qnil;
 867:       input_wait_mask &= ~ChannelMask (inchannel);
 868:     }
 869: }
 870: 
 871: DEFUN ("accept-process-output", Faccept_process_output, Saccept_process_output,
 872:   0, 1, 0,
 873:   "Allow any pending output from subprocesses to be read by Emacs.\n\
 874: It is read into the processs' buffers or given to their filter functions.\n\
 875: Non-nil arg PROCESS means do not return until some output has been received\n\
 876: from PROCESS.")
 877:   (proc)
 878:      Lisp_Object proc;
 879: {
 880:   if (NULL (proc))
 881:     wait_reading_process_input (-1, 0, 0);
 882:   else
 883:     {
 884:       proc = get_process (proc);
 885:       wait_reading_process_input (0, 10 + XFASTINT (XPROCESS (proc)->infd),
 886:                   0);
 887:     }
 888:   return Qnil;
 889: }
 890: 
 891: /* Read and dispose of subprocess output
 892:  while waiting for timeout to elapse and/or keyboard input to be available.
 893: 
 894:  time_limit is the timeout in seconds, or zero for no limit.
 895:  -1 means gobble data available immediately but don't wait for any.
 896: 
 897:  read_kbd is 1 to return when input is available.
 898:  Negative means caller will actually read the input.
 899:  10 + I means wait until input received from channel I.
 900: 
 901:  do_display means redisplay should be done to show
 902:  subprocess output that arrives.  */
 903: 
 904: wait_reading_process_input (time_limit, read_kbd, do_display)
 905:      int time_limit, read_kbd, do_display;
 906: {
 907:   register int channel, nfds, m;
 908:   int Available = 0;
 909:   int Exception;
 910:   Lisp_Object proc;
 911: #ifdef HAVE_TIMEVAL
 912:   struct timeval timeout, end_time, garbage;
 913: #else
 914:   long timeout, end_time, temp;
 915: #endif /* not HAVE_TIMEVAL */
 916:   int Atemp;
 917:   int wait_channel = 0;
 918:   extern kbd_count;
 919: 
 920:   if (read_kbd > 10)
 921:     {
 922:       wait_channel = read_kbd - 10;
 923:       read_kbd = 0;
 924:     }
 925: 
 926:   /* Since we may need to wait several times,
 927:      compute the absolute time to return at.  */
 928:   if (time_limit)
 929:     {
 930: #ifdef HAVE_TIMEVAL
 931:       gettimeofday (&end_time, &garbage);
 932:       end_time.tv_sec += time_limit;
 933: #else /* not HAVE_TIMEVAL */
 934:       time (&end_time);
 935:       end_time += time_limit;
 936: #endif /* not HAVE_TIMEVAL */
 937:     }
 938: 
 939:   while (1)
 940:     {
 941:       /* If calling from keyboard input, do not quit
 942: 	 since we want to return C-g as an input character.
 943: 	 Otherwise, do pending quit if requested.  */
 944:       if (read_kbd >= 0)
 945:     QUIT;
 946: 
 947:       /* If status of something has changed, and no input is available,
 948: 	 notify the user of the change right away */
 949:       if (child_changed && do_display)
 950:     {
 951:       Atemp = input_wait_mask;
 952: #ifdef HAVE_TIMEVAL
 953:       timeout.tv_sec=0; timeout.tv_usec=0;
 954: #else /* not HAVE_TIMEVAL */
 955:       timeout = 0;
 956: #endif /* not HAVE_TIMEVAL */
 957:       if (select (MAXDESC, &Atemp, 0, 0, &timeout) <= 0)
 958:         change_msgs();
 959:     }
 960: 
 961:       if (fix_screen_hook)
 962:     (*fix_screen_hook) ();
 963: 
 964:       /* Compute time from now till when time limit is up */
 965:       /* Exit if already run out */
 966:       if (time_limit == -1)
 967:     {
 968:       /* -1 specified for timeout means
 969: 	     gobble output available now
 970: 	     but don't wait at all. */
 971:       time_limit = -2;
 972: #ifdef HAVE_TIMEVAL
 973:       timeout.tv_sec = 0;
 974:       timeout.tv_usec = 0;
 975: #else
 976:       timeout = 0;
 977: #endif /* not HAVE_TIMEVAL */
 978:     }
 979:       else if (time_limit)
 980:     {
 981: #ifdef HAVE_TIMEVAL
 982:       gettimeofday (&timeout, &garbage);
 983:       timeout.tv_sec = end_time.tv_sec - timeout.tv_sec;
 984:       timeout.tv_usec = end_time.tv_usec - timeout.tv_usec;
 985:       if (timeout.tv_usec < 0)
 986:         timeout.tv_usec += 1000000,
 987:         timeout.tv_sec--;
 988:       if (timeout.tv_sec < 0)
 989:         break;
 990: #else /* not HAVE_TIMEVAL */
 991:           time (&temp);
 992:       timeout = end_time - temp;
 993:       if (timeout < 0)
 994:         break;
 995: #endif /* not HAVE_TIMEVAL */
 996:     }
 997:       else
 998:     {
 999: #ifdef HAVE_TIMEVAL
1000:       /* If no real timeout, loop sleeping with a big timeout
1001: 	     so that input interrupt can wake us up by zeroing it  */
1002:       timeout.tv_sec = 100;
1003:       timeout.tv_usec = 0;
1004: #else /* not HAVE_TIMEVAL */
1005:           timeout = 100000; /* 100000 recognized by the select emulator */
1006: #endif /* not HAVE_TIMEVAL */
1007:     }
1008: 
1009:       /* Cause C-g and alarm signals to take immediate action,
1010: 	 and cause input available signals to zero out timeout */
1011:       if (read_kbd < 0)
1012:     set_waiting_for_input (&timeout);
1013: 
1014:       /* Wait till there is something to do */
1015: 
1016:       Available = Exception = input_wait_mask;
1017:       if (!read_kbd)
1018:     Available &= ~1;
1019: 
1020:       if (read_kbd && kbd_count)
1021:     nfds = 0;
1022:       else
1023:     nfds = select (MAXDESC, &Available, 0, &Exception, &timeout);
1024: 
1025:       if (fix_screen_hook)
1026:     (*fix_screen_hook) ();
1027: 
1028:       /* Make C-g and alarm signals set flags again */
1029:       clear_waiting_for_input ();
1030: 
1031:       if (time_limit && nfds == 0)  /* timeout elapsed */
1032:     break;
1033:       if (nfds < 0)
1034:     {
1035:       if (errno == EINTR)
1036:         Available = 0;
1037:       else if (errno == EBADF)
1038:         abort ();
1039:       else
1040:         error("select error: %s", sys_errlist[errno]);
1041:     }
1042: 
1043:       /* Check for keyboard input */
1044:       /* If there is any, return immediately
1045: 	 to give it higher priority than subprocesses */
1046: 
1047:       if (read_kbd && (kbd_count || !NULL (Vquit_flag)))
1048:     break;
1049: 
1050:       if (read_kbd && (Available & ChannelMask (0)))
1051:     break;
1052: 
1053: #ifdef vipc
1054:       /* Check for connection from other process */
1055: 
1056:       if (Available & ChannelMask (comm_server))
1057:     {
1058:       Available &= ~(ChannelMask (comm_server));
1059:       create_commchan ();
1060:     }
1061: #endif vipc
1062: 
1063:       /* Check for data from a process or a command channel */
1064: 
1065:       for (channel = 3; Available && channel < MAXDESC; channel++)
1066:     {
1067:       m = ChannelMask (channel);
1068:       if (m & Available)
1069:         {
1070:           Available &= ~m;
1071:           /* If waiting for this channel,
1072: 		 arrange to return as soon as no more input
1073: 		 to be processed.  No more waiting.  */
1074:           if (wait_channel == channel)
1075:         {
1076:           wait_channel = 0;
1077:           time_limit = -1;
1078:         }
1079:           proc = chan_process[channel];
1080:           if (NULL (proc))
1081:         continue;
1082: 
1083: #ifdef vipc
1084:           /* It's a command channel */
1085:           if (!NULL (XPROCESS (proc)->command_channel_p))
1086:         {
1087:           ProcessCommChan (channel, proc);
1088:           if (NULL (XPROCESS (proc)->command_channel_p))
1089:             {
1090:               /* It has ceased to be a command channel! */
1091:               int bytes_available;
1092:               if (ioctl (channel, FIONREAD, &bytes_available) < 0)
1093:             bytes_available = 0;
1094:               if (bytes_available)
1095:             Available |= m;
1096:             }
1097:           continue;
1098:         }
1099: #endif vipc
1100: 
1101:           /* Read data from the process, starting with our
1102: 		 buffered-ahead character if we have one.  */
1103: 
1104:           if (read_process_output (proc, channel) > 0)
1105:         {
1106:           if (do_display)
1107:             DoDsp (1);
1108:         }
1109:           else
1110:         {
1111:           /* Preserve status of processes already terminated.  */
1112:           child_changed++;
1113:           deactivate_process (proc);
1114: 
1115: /*
1116:  * With pty:s, when the parent process of a pty exits we are notified,
1117:  * just as we would be with any of our other children.  After the process
1118:  * exits, select() will indicate that we can read the channel.  When we
1119:  * do this, read() returns 0.  Upon receiving this, we close the channel.
1120:  *
1121:  * For external channels, when the peer closes the connection, select()
1122:  * will indicate that we can read the channel.  When we do this, read()
1123:  * returns -1 with errno = ECONNRESET.  Since we never get notified of
1124:  * this via wait3(), we must explictly mark the process as having exited.
1125:  */
1126:           if ((XFASTINT (XPROCESS (proc)->flags) & PROC_STATUS)
1127:               == RUNNING)
1128:             {
1129:               XFASTINT (XPROCESS (proc)->flags) = EXITED | CHANGED;
1130:               XFASTINT (XPROCESS (proc)->reason) = 0;
1131:             }
1132:         }
1133:         }
1134:     } /* end for */
1135:     } /* end while */
1136: }
1137: 
1138: /* Read pending output from the process channel,
1139:    starting with our buffered-ahead character if we have one.
1140:    Yield number of characters read.  */
1141: 
1142: read_process_output (proc, channel)
1143:      Lisp_Object proc;
1144:      register int channel;
1145: {
1146:   register int count;
1147:   register int total = 0;
1148:   char buf[1024];
1149: 
1150:   while (1)
1151:     {
1152:       if (proc_buffered_char[channel] < 0)
1153:     count = read (channel, buf, sizeof buf);
1154:       else
1155:     {
1156:       buf[0] = proc_buffered_char[channel];
1157:       proc_buffered_char[channel] = -1;
1158:       count = read (channel, buf + 1, sizeof buf - 1) + 1;
1159:     }
1160: 
1161:       if (count <= 0)
1162:     break;
1163: 
1164:       total += count;
1165:       handle_process_output (proc, buf, count);
1166:     }
1167:   return total;
1168: }
1169: 
1170: /*
1171:  * Output has been received from a process on "chan" and should be stuffed in
1172:  * the correct buffer.
1173:  */
1174: handle_process_output (proc, chars, nchars)
1175:      Lisp_Object proc;
1176:      char *chars;
1177:      int nchars;
1178: {
1179:   Lisp_Object outstream;
1180:   register struct buffer *old = bf_cur;
1181:   register struct Lisp_Process *p = XPROCESS (proc);
1182:   register int opoint;
1183: 
1184:   outstream = p->filter;
1185:   if (!NULL (outstream))
1186:     {
1187:       call2 (outstream, proc, make_string (chars, nchars));
1188:       return 1;
1189:     }
1190: 
1191:   /* If no filter, write into buffer if it isn't dead.  */
1192:   if (!NULL (p->buffer) && !NULL (XBUFFER (p->buffer)->name))
1193:     {
1194:       Fset_buffer (p->buffer);
1195:       opoint = point;
1196: 
1197:       /* Insert new output into buffer
1198: 	 at the current end-of-output marker,
1199: 	 thus preserving logical ordering of input and output.  */
1200:       if (XMARKER (p->mark)->buffer)
1201:     SetPoint (marker_position (p->mark));
1202:       else
1203:     SetPoint (NumCharacters + 1);
1204:       if (point <= opoint)
1205:     opoint += nchars;
1206: 
1207:       InsCStr (chars, nchars);
1208:       Fset_marker (p->mark, make_number (point), p->buffer);
1209:       RedoModes++;
1210: 
1211:       SetPoint (opoint);
1212:       SetBfp (old);
1213:     }
1214:   else return 0;
1215: 
1216:   /* Old feature was, delete early chars in chunks if
1217:     buffer gets bigger that ProcessBufferSize.
1218:     This feature is flushed */
1219: 
1220:   return 1;
1221: }
1222: 
1223: /* Sending data to subprocess */
1224: 
1225: jmp_buf send_process_frame;
1226: 
1227: send_process_trap ()
1228: {
1229: #ifdef BSD4_1
1230:   sigrelse (SIGPIPE);
1231:   sigrelse (SIGALRM);
1232: #endif /* BSD4_1 */
1233:   longjmp (send_process_frame, 1);
1234: }
1235: 
1236: send_process_1 (proc, buf, len)
1237:      Lisp_Object proc;
1238:      char *buf;
1239:      int len;
1240: {
1241:   /* Don't use register vars; longjmp can lose them.  */
1242:   int rv;
1243:   unsigned char *procname = XSTRING (XPROCESS (proc)->name)->data;
1244: 
1245:   if ((XFASTINT (XPROCESS (proc)->flags) & PROC_STATUS) != RUNNING)
1246:     error ("Process %s not running", procname);
1247: 
1248:   signal (SIGPIPE, send_process_trap);
1249: 
1250:   if (!setjmp (send_process_frame))
1251:     while (len > 0)
1252:       {
1253:     rv = write (XFASTINT (XPROCESS (proc)->outfd), buf, len);
1254:     if (rv < 0)
1255:       break;
1256:     buf += rv;
1257:     len -= rv;
1258:       }
1259:   else
1260:     {
1261:       signal (SIGPIPE, SIG_DFL);
1262:       XFASTINT (XPROCESS (proc)->flags) =  EXITED | CHANGED;
1263:       deactivate_process (proc);
1264:       error ("SIGPIPE raised on process %s; closed it", procname);
1265:     }
1266: 
1267:   signal (SIGPIPE, SIG_DFL);
1268: 
1269:   if (rv < 0)
1270:     report_file_error ("writing to process", Fcons (proc, Qnil));
1271: }
1272: 
1273: /*** Is it really safe for this to get an error ?  */
1274: 
1275: send_process (proc, buf, count)
1276:      Lisp_Object proc;
1277:      char *buf;
1278:      int count;
1279: {
1280: #ifdef vipc
1281:   struct { int checkword, type, datalen; } header;
1282: 
1283:   if (!NULL (XPROCESS (proc)->command_channel_p))
1284:     {
1285:       checkword = UNIQUE_FROB;
1286:       type = VIPC_MESG;
1287:       datalen = count;
1288:       send_process_1 (proc, &header, sizeof header);
1289:     }
1290: #endif vipc
1291:   send_process_1 (proc, buf, count);
1292: }
1293: 
1294: DEFUN ("send-region", Fsend_region, Ssend_region, 3, 3, 0,
1295:   "Send current contents of region as input to PROCESS.\n\
1296: PROCESS may be a process name.\n\
1297: Called from program, takes three arguments, PROCESS, START and END.")
1298:   (process, start, end)
1299:      Lisp_Object process, start, end;
1300: {
1301:   Lisp_Object proc;
1302:   proc = get_process (process);
1303:   validate_region (&start, &end);
1304: 
1305:   if (XINT (start) < bf_s1 && XINT (end) >= bf_s1)
1306:     GapTo (start);
1307: 
1308:   send_process (proc, &CharAt (XINT (start)), XINT (end) - XINT (start));
1309: 
1310:   return Qnil;
1311: }
1312: 
1313: DEFUN ("send-string", Fsend_string, Ssend_string, 2, 2, 0,
1314:   "Send PROCESS the contents of STRING as input.\n\
1315: PROCESS may be a process name.")
1316:   (process, string)
1317:      Lisp_Object process, string;
1318: {
1319:   Lisp_Object proc;
1320:   CHECK_STRING (string, 1);
1321:   proc = get_process (process);
1322:   send_process (proc, XSTRING (string)->data, XSTRING (string)->size);
1323:   return Qnil;
1324: }
1325: 
1326: /* send a signal number SIGNO to PROCESS.
1327:    CURRENT_GROUP means send to the process group that currently owns
1328:    the terminal being used to communicate with PROCESS.
1329:    This is used for various commands in shell mode.
1330:    If NOMSG is zero, insert signal-announcements into process's buffers
1331:    right away.  */
1332: 
1333: sig_process (process, signo, current_group, nomsg)
1334:      Lisp_Object process;
1335:      int signo;
1336:      Lisp_Object current_group;
1337:      int nomsg;
1338: {
1339:   Lisp_Object proc;
1340:   register struct Lisp_Process *p;
1341:   int gid;
1342: 
1343:   proc = get_process (process);
1344:   p = XPROCESS (proc);
1345: 
1346:   if (NULL (p->childp))
1347:     error ("Process %s is not a subprocess",
1348:        XSTRING (p->name)->data);
1349:   if (!XFASTINT (p->infd))
1350:     error ("Process %s is not active",
1351:        XSTRING (p->name)->data);
1352: 
1353: #ifdef TIOCGPGRP        /* Not sure about this! (fnf) */
1354:   /* If we are using pgrps, get a pgrp number and make it negative.  */
1355:   if (!NULL (current_group))
1356:     {
1357:       ioctl (XFASTINT (p->infd), TIOCGPGRP, &gid);
1358:       gid = - gid;
1359:     }
1360:   else
1361:     gid = - XFASTINT (p->pid);
1362: #else /* not using pgrps */
1363:   /* Can't select pgrps on this system, so we know that
1364:      the child itself heads the pgrp.  */
1365:   gid = - XFASTINT (p->pid);
1366: #endif /* not using pgrps */
1367: 
1368:   switch (signo)
1369:     {
1370: #ifdef SIGCONT
1371:     case SIGCONT:
1372:       XFASTINT (p->flags) = RUNNING | CHANGED;
1373:       child_changed++;
1374:       break;
1375: #endif
1376:     case SIGINT:
1377:     case SIGQUIT:
1378:     case SIGKILL:
1379:       flush_pending_output (XFASTINT (p->infd));
1380:       break;
1381:     }
1382:   /* gid may be a pid, or minus a pgrp's number */
1383: #ifdef BSD
1384:   /* On bsd, [man says] kill does not accept a negative number to kill a pgrp.
1385:      Must do that differently.  */
1386:   killpg (-gid, signo);
1387: #else /* Not BSD.  */
1388:   kill (gid, signo);
1389: #endif /* Not BSD.  */
1390: 
1391:   /* Put notices in buffers now, since it is safe now.
1392:      Because of this, we know that a process we have just killed
1393:      will never need to use its buffer again.  */
1394:   if (!nomsg)
1395:     change_msgs ();
1396: }
1397: 
1398: DEFUN ("interrupt-process", Finterrupt_process, Sinterrupt_process, 0, 2, 0,
1399:   "Interrupt process PROCESS.  May be process or name of one.\n\
1400: Nil or no arg means current buffer's process.\n\
1401: Second arg CURRENT-GROUP non-nil means send signal to\n\
1402: the current process-group of the process's controlling terminal\n\
1403: rather than to the process's own process group.\n\
1404: If the process is a shell, this means interrupt current subjob\n\
1405: rather than the shell.")
1406:   (process, current_group)
1407:      Lisp_Object process, current_group;
1408: {
1409:   sig_process (process, SIGINT, current_group, 0);
1410:   return process;
1411: }
1412: 
1413: DEFUN ("kill-process", Fkill_process, Skill_process, 0, 2, 0,
1414:   "Kill process PROCESS.  May be process or name of one.\n\
1415: See function interrupt-process for more details on usage.")
1416:   (process, current_group)
1417:      Lisp_Object process, current_group;
1418: {
1419:   sig_process (process, SIGKILL, current_group, 0);
1420:   return process;
1421: }
1422: 
1423: DEFUN ("quit-process", Fquit_process, Squit_process, 0, 2, 0,
1424:   "Send QUIT signal to process PROCESS.  May be process or name of one.\n\
1425: See function interrupt-process for more details on usage.")
1426:   (process, current_group)
1427:      Lisp_Object process, current_group;
1428: {
1429:   sig_process (process, SIGQUIT, current_group, 0);
1430:   return process;
1431: }
1432: 
1433: DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0,
1434:   "Stop process PROCESS.  May be process or name of one.\n\
1435: See function interrupt-process for more details on usage.")
1436:   (process, current_group)
1437:      Lisp_Object process, current_group;
1438: {
1439: #ifndef SIGTSTP
1440:   error ("no SIGTSTP support");
1441: #else
1442:   sig_process (process, SIGTSTP, current_group, 0);
1443: #endif
1444:   return process;
1445: }
1446: 
1447: DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0,
1448:   "Continue process PROCESS.  May be process or name of one.\n\
1449: See function interrupt-process for more details on usage.")
1450:   (process, current_group)
1451:      Lisp_Object process, current_group;
1452: {
1453: #ifdef SIGCONT
1454:     sig_process (process, SIGCONT, current_group, 0);
1455: #else
1456:     error ("no SIGCONT support");
1457: #endif
1458:   return process;
1459: }
1460: 
1461: DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0,
1462:   "Make PROCESS see end-of-file in its input.\n\
1463: Eof comes after any text already sent to it.\n\
1464: Nil or no arg means current buffer's process.")
1465:   (process)
1466:      Lisp_Object process;
1467: {
1468:   Lisp_Object proc;
1469: 
1470:   proc = get_process (process);
1471:   send_process (proc, "\004", 1);
1472:   return process;
1473: }
1474: 
1475: /* Kill all processes associated with `buffer'.
1476:  If `buffer' is nil, kill all processes  */
1477: 
1478: kill_buffer_processes (buffer)
1479:      Lisp_Object buffer;
1480: {
1481:   Lisp_Object tail, proc;
1482: 
1483:   for (tail = Vprocess_alist; XGCTYPE (tail) == Lisp_Cons;
1484:        tail = XCONS (tail)->cdr)
1485:     {
1486:       proc = XCONS (XCONS (tail)->car)->cdr;
1487:       if (XGCTYPE (proc) == Lisp_Process
1488:       && (NULL (buffer) || EQ (XPROCESS (proc)->buffer, buffer)))
1489:     if (XFASTINT (XPROCESS (proc)->infd))
1490:       sig_process (proc, SIGKILL, Qnil, 1);
1491:     }
1492: }
1493: 
1494: count_active_processes ()
1495: {
1496:   register Lisp_Object tail, proc;
1497:   register int count = 0;
1498: 
1499:   for (tail = Vprocess_alist; !NULL (tail); tail = Fcdr (tail))
1500:     {
1501:       proc = Fcdr (Fcar (tail));
1502: 
1503:       if ((1 << (XFASTINT (XPROCESS (proc)->flags) & PROC_STATUS)
1504:        & ((1 << RUNNING) | (1 << STOPPED)))
1505:       && NULL (XPROCESS (proc)->kill_without_query))
1506:     count++;
1507:     }
1508: 
1509:   return count;
1510: }
1511: 
1512: /* On receipt of a signal that a child status has changed,
1513:  loop asking about children with changed statuses until
1514:  the system says there are no more.
1515:    All we do is change the flags components;
1516:  we do not run sentinels or print notifications.
1517:  That is saved for the next time keyboard input is done,
1518:  in order to avoid timing errors.  */
1519: 
1520: /** WARNING: this can be called during garbage collection.
1521:  Therefore, it must not be fooled by the presence of mark bits in
1522:  Lisp objects.  */
1523: 
1524: /** USG WARNING:  Although it is not obvious from the documentation
1525:  in signal(2), on a USG system the SIGCLD handler MUST NOT call
1526:  signal() before executing at least one wait(), otherwise the handler
1527:  will be called again, resulting in an infinite loop.  The relevant
1528:  portion of the documentation reads "SIGCLD signals will be queued
1529:  and the signal-catching function will be continually reentered until
1530:  the queue is empty".  Invoking signal() causes the kernel to reexamine
1531:  the SIGCLD queue.   Fred Fish, UniSoft Systems Inc. */
1532: 
1533: child_sig (signo)
1534:      int signo;
1535: {
1536:   register int pid;
1537:   WAITTYPE w;
1538:   Lisp_Object tail, proc;
1539:   register struct Lisp_Process *p;
1540: 
1541: #ifdef BSD4_1
1542:   extern int synch_process_pid;
1543:   extern int sigheld;
1544:   sigheld |= sigbit (SIGCHLD);
1545: #endif
1546: 
1547: loop:
1548: 
1549: #ifdef WNOHANG
1550: #ifndef WUNTRACED
1551: #define WUNTRACED 0
1552: #endif /* no WUNTRACED */
1553:   pid = wait3 (&w, WNOHANG | WUNTRACED, 0);
1554:   if (pid <= 0)
1555:     {
1556:       if (errno == EINTR)
1557:     {
1558:       errno = 0;
1559:       goto loop;
1560:     }
1561:   /* USG systems forget handlers when they are used;
1562:      must reestablish each time */
1563: #ifdef USG
1564:       signal (signo, child_sig);   /* WARNING - must come after wait3() */
1565: #endif
1566: #ifdef  BSD4_1
1567:       sigheld &= ~sigbit (SIGCHLD);
1568:       sigrelse (SIGCHLD);
1569: #endif
1570:       return;
1571:     }
1572: #else
1573:   pid = wait (&w);
1574: #endif /* no WNOHANG */
1575: 
1576: #ifdef BSD4_1
1577:   if (synch_process_pid == pid)
1578:     synch_process_pid = 0;         /* Zero it to show process has died. */
1579: #endif
1580: 
1581:   for (tail = Vprocess_alist; XSYMBOL (tail) != XSYMBOL (Qnil); tail = XCONS (tail)->cdr)
1582:     {
1583:       proc = XCONS (XCONS (tail)->car)->cdr;
1584:       p = XPROCESS (proc);
1585:       if (!NULL (p->childp) && XFASTINT (p->pid) == pid)
1586:     break;
1587:     }
1588: 
1589:   if (XSYMBOL (tail) == XSYMBOL (Qnil))
1590: #ifdef USG
1591:     goto ignore;
1592: #else
1593:     goto loop;      /* We don't know who this is */
1594: #endif
1595: 
1596:   child_changed++;
1597:   if (WIFSTOPPED (w))
1598:     {
1599:       XFASTINT (p->flags) = STOPPED | CHANGED;
1600:       XFASTINT (p->reason) = WSTOPSIG (w);
1601:     }
1602:   else if (WIFEXITED (w))
1603:     {
1604:       XFASTINT (p->flags) = EXITED | CHANGED;
1605:       if (WCOREDUMP (w))
1606:     XFASTINT (p->flags) |= COREDUMPED;
1607:       XFASTINT (p->reason) = WRETCODE (w);
1608:     }
1609:   else if (WIFSIGNALED (w))
1610:     {
1611:       XFASTINT (p->flags) = SIGNALED | CHANGED;
1612:       if (WCOREDUMP (w))
1613:     XFASTINT (p->flags) |= COREDUMPED;
1614:       XFASTINT (p->reason) = WTERMSIG (w);
1615:     }
1616: #ifndef USG
1617:   goto loop;
1618: #else
1619:  ignore:
1620:   signal (signo, child_sig);
1621: #endif /* not USG */
1622: }
1623: 
1624: /* Find all process marked as "changed"
1625:   and notify the user in a suitable fashion
1626:   (either run the sentinel or output a message).
1627:   This is done while Emacs is waiting for keyboard input */
1628: 
1629: change_msgs()
1630: {
1631:   Lisp_Object tail, proc, buffer;
1632:   register struct Lisp_Process *p;
1633:   register struct buffer *old = bf_cur;
1634:   char line[50];
1635:   int opoint;
1636: 
1637:   child_changed = 0;
1638: 
1639:   for (tail = Vprocess_alist; !NULL (tail); tail = Fcdr (tail))
1640:     {
1641:       proc = Fcdr (Fcar (tail));
1642:       p = XPROCESS (proc);
1643: 
1644:       if (!(XFASTINT (p->flags) & CHANGED))
1645:     continue;
1646: 
1647:       /* If process is still active, read any output that remains.  */
1648:       if (XFASTINT (p->infd))
1649:     read_process_output (proc, XFASTINT (p->infd));
1650: 
1651:       XFASTINT (p->flags) &= ~CHANGED;
1652: 
1653:       line[0] = 0;
1654:       buffer = p->buffer;
1655: 
1656:       if ((XFASTINT (p->flags) & PROC_STATUS) == SIGNALED
1657:       || (XFASTINT (p->flags) & PROC_STATUS) == STOPPED)
1658:     {
1659:       sprintf (line, "%s%s\n",
1660:            XFASTINT (p->reason) < NSIG
1661:              ? sys_siglist[XFASTINT (p->reason)] : "unknown",
1662:            XFASTINT (p->flags) & COREDUMPED ? " (core dumped)" : "");
1663:       if (line[0] >= 'A' && line[0] <= 'Z')
1664:         line[0] += 040;
1665: 
1666:       if ((XFASTINT (p->flags) & PROC_STATUS) == SIGNALED)
1667:         if (delete_exited_processes)
1668:           remove_process (proc);
1669:         else
1670:           deactivate_process (proc);
1671:     }
1672:       else if ((XFASTINT (p->flags) & PROC_STATUS) == EXITED)
1673:     {
1674:       if (XFASTINT (p->reason))
1675:         sprintf (line, "exited abnormally with code %d\n",
1676:              XFASTINT (p->reason));
1677:       else
1678:         sprintf (line, "finished\n");
1679: 
1680:       if (delete_exited_processes)
1681:         remove_process (proc);
1682:       else
1683:         deactivate_process (proc);
1684:     }
1685: 
1686:       if (!NULL (p->sentinel))
1687:     exec_sentinel (proc, build_string (line));
1688:       else if (line[0] && !NULL (buffer))
1689:     {
1690:       /* Avoid error if buffer is deleted
1691: 	     (probably that's why the process is dead, too) */
1692:       if (NULL (XBUFFER (buffer)->name))
1693:         continue;
1694:       Fset_buffer (buffer);
1695:       opoint = point;
1696:       SetPoint (NumCharacters + 1);
1697:       if (point == opoint)
1698:         opoint = -1;
1699:       InsStr ("\nProcess ");
1700:       Finsert (1, &p->name);
1701:       InsStr (" ");
1702:       InsStr (line);
1703:       if (opoint > 0)
1704:         SetPoint (opoint);
1705:     }
1706:     } /* end for */
1707: 
1708:   SetBfp (old);
1709: 
1710:   RedoModes++;  /* in case buffers use %s in mode-line-format */
1711:   DoDsp (1);
1712: }
1713: 
1714: exec_sentinel (proc, reason)
1715:      Lisp_Object proc, reason;
1716: {
1717:   Lisp_Object sentinel;
1718:   register struct Lisp_Process *p = XPROCESS (proc);
1719: 
1720:   sentinel = p->sentinel;
1721:   if (NULL (sentinel))
1722:     return;
1723: 
1724:   p->sentinel = Qnil;
1725:   call2 (sentinel, proc, reason);
1726:   p->sentinel = sentinel;
1727: }
1728: 
1729: init_process ()
1730: {
1731:   register int i;
1732: 
1733: #ifdef SIGCHLD
1734:   signal (SIGCHLD, child_sig);
1735: #endif
1736: 
1737:   input_wait_mask = ChannelMask(0);
1738:   Vprocess_alist = Qnil;
1739:   for (i = 0; i < MAXDESC; i++)
1740:     {
1741:       chan_process[i] = Qnil;
1742:       proc_buffered_char[i] = -1;
1743:     }
1744: }
1745: 
1746: syms_of_process ()
1747: {
1748:   Qprocessp = intern ("processp");
1749:   staticpro (&Qprocessp);
1750: 
1751:   staticpro (&Vprocess_alist);
1752: 
1753:   DefBoolVar ("delete-exited-processes", &delete_exited_processes,
1754:     "*Non-nil means delete processes immediately when they exit.\n\
1755: nil means don't delete them until list-processes is done.");
1756: 
1757:   delete_exited_processes = 1;
1758: 
1759:   defsubr (&Sprocessp);
1760:   defsubr (&Sget_process);
1761:   defsubr (&Sget_buffer_process);
1762:   defsubr (&Sdelete_process);
1763:   defsubr (&Sprocess_status);
1764:   defsubr (&Sprocess_id);
1765:   defsubr (&Sprocess_name);
1766:   defsubr (&Sprocess_command);
1767:   defsubr (&Sset_process_buffer);
1768:   defsubr (&Sprocess_buffer);
1769:   defsubr (&Sprocess_mark);
1770:   defsubr (&Sset_process_filter);
1771:   defsubr (&Sprocess_filter);
1772:   defsubr (&Sset_process_sentinel);
1773:   defsubr (&Sprocess_sentinel);
1774:   defsubr (&Sprocess_kill_without_query);
1775:   defsubr (&Slist_processes);
1776:   defsubr (&Sstart_process);
1777:   defsubr (&Saccept_process_output);
1778:   defsubr (&Ssend_region);
1779:   defsubr (&Ssend_string);
1780:   defsubr (&Sinterrupt_process);
1781:   defsubr (&Skill_process);
1782:   defsubr (&Squit_process);
1783:   defsubr (&Sstop_process);
1784:   defsubr (&Scontinue_process);
1785:   defsubr (&Sprocess_send_eof);
1786: }
1787: 
1788: #endif subprocesses

Defined functions

Defined variables

Defined macros