home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / mint / editors / mntemacs.zoo / src / callproc.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-04-07  |  13.8 KB  |  562 lines
  1. /* Synchronous subprocess invocation for GNU Emacs.
  2.    Copyright (C) 1985, 1986, 1987, 1988, 1990 Free Software Foundation, Inc.
  3.  
  4. This file is part of GNU Emacs.
  5.  
  6. GNU Emacs is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 1, or (at your option)
  9. any later version.
  10.  
  11. GNU Emacs is distributed in the hope that it will be useful,
  12. but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. GNU General Public License for more details.
  15.  
  16. You should have received a copy of the GNU General Public License
  17. along with GNU Emacs; see the file COPYING.  If not, write to
  18. the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19.  
  20. /**
  21.  **  (sjk)++ The space to build a temporary file name.
  22.  **          Dev null installed flag, do not install /dev/null
  23.  **          until emacs is run in interactive mode (not in dumps).
  24.  **/
  25. #if defined(atarist)
  26. char   at_tmpname[32];
  27. #ifndef __MINT__
  28. static short null_dev_inst = 0;
  29. #endif
  30. #endif
  31.  
  32. #include <signal.h>
  33.  
  34. #include "config.h"
  35.  
  36. #include <sys/types.h>
  37. #define PRIO_PROCESS 0
  38. #include <sys/file.h>
  39. #ifdef USG5
  40. #include <fcntl.h>
  41. #endif
  42.  
  43. #ifndef O_RDONLY
  44. #define O_RDONLY 0
  45. #endif
  46.  
  47. #ifndef O_WRONLY
  48. #define O_WRONLY 1
  49. #endif
  50.  
  51. #include "lisp.h"
  52. #include "commands.h"
  53. #include "buffer.h"
  54. #include "paths.h"
  55.  
  56. #define max(a, b) ((a) > (b) ? (a) : (b))
  57.  
  58. Lisp_Object Vexec_path, Vexec_directory;
  59.  
  60. Lisp_Object Vshell_file_name;
  61.  
  62. #ifndef MAINTAIN_ENVIRONMENT
  63. /* List of strings to append to front of environment of
  64.    all subprocesses when they are started.  */
  65.  
  66. Lisp_Object Vprocess_environment;
  67. #endif
  68.  
  69. #ifdef BSD4_1
  70. /* Set nonzero when a synchronous subprocess is made,
  71.    and set to zero again when it is observed to die.
  72.    We wait for this to be zero in order to wait for termination.  */
  73. int synch_process_pid;
  74. #endif /* BSD4_1 */
  75.  
  76. Lisp_Object
  77. call_process_cleanup (fdpid)
  78.      Lisp_Object fdpid;
  79. {
  80.   register Lisp_Object fd, pid;
  81.   fd = Fcar (fdpid);
  82.   pid = Fcdr (fdpid);
  83.  
  84. /**
  85.  **  (sjk)++ We close the file in the function from where the external
  86.  **          process was creaed. 
  87.  **/
  88. #if defined(atarist) && !defined(__MINT__)
  89.   if (XFASTINT(fd)>0)  close (XFASTINT (fd));
  90. #else
  91.   close (XFASTINT (fd));
  92.   kill (XFASTINT (pid), SIGKILL);
  93. #endif
  94.   return Qnil;
  95. }
  96.  
  97. #ifdef VMS
  98. extern noshare char **environ;
  99. #else
  100. extern char **environ;
  101. #endif
  102.  
  103. DEFUN ("call-process", Fcall_process, Scall_process, 1, MANY, 0,
  104.   "Call PROGRAM in separate process.\n\
  105. Program's input comes from file INFILE (nil means /dev/null).\n\
  106. Insert output in BUFFER before point; t means current buffer;\n\
  107.  nil for BUFFER means discard it; 0 means discard and don't wait.\n\
  108. Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
  109. Remaining arguments are strings passed as command arguments to PROGRAM.\n\
  110. This function waits for PROGRAM to terminate;\n\
  111. if you quit, the process is killed.")
  112.   (nargs, args)
  113.      int nargs;
  114.      register Lisp_Object *args;
  115. {
  116.   Lisp_Object display, buffer, path;
  117.   int fd[2];
  118.   int filefd;
  119.   register int pid;
  120.   char buf[1024];
  121.   int count = specpdl_ptr - specpdl;
  122.   register unsigned char **new_argv
  123.     = (unsigned char **) alloca ((max (2, nargs - 2)) * sizeof (char *));
  124.   struct buffer *old = current_buffer;
  125.  
  126. /**
  127.  **  (sjk)++ Install bammi's plug&play null data sink.
  128.  **/
  129. #if defined(atarist)
  130. #ifndef __MINT__
  131.   if (!null_dev_inst)
  132.     { install_null();
  133.       null_dev_inst = 1;
  134.     }
  135. #endif
  136. #endif
  137.  
  138.   CHECK_STRING (args[0], 0);
  139.  
  140.   if (nargs <= 1 || NULL (args[1]))
  141. #ifdef VMS
  142.     args[1] = build_string ("NLA0:");
  143. #else
  144.     args[1] = build_string ("/dev/null");
  145. #endif /* not VMS */
  146.   else
  147.     args[1] = Fexpand_file_name (args[1], current_buffer->directory);
  148.  
  149.   CHECK_STRING (args[1], 1);
  150.  
  151.   {
  152.     register Lisp_Object tem;
  153.     buffer = tem = args[2];
  154.     if (nargs <= 2)
  155.       buffer = Qnil;
  156.     else if (!(EQ (tem, Qnil) || EQ (tem, Qt)
  157.            || XFASTINT (tem) == 0))
  158.       {
  159.     buffer = Fget_buffer (tem);
  160.     CHECK_BUFFER (buffer, 2);
  161.       }
  162.   }
  163.  
  164.   display = nargs >= 3 ? args[3] : Qnil;
  165.  
  166.   {
  167.     register int i;
  168.     for (i = 4; i < nargs; i++)
  169.       {
  170.     CHECK_STRING (args[i], i);
  171.     new_argv[i - 3] = XSTRING (args[i])->data;
  172.       }
  173.     /* Program name is first command arg */
  174.     new_argv[0] = XSTRING (args[0])->data;
  175.     new_argv[i - 3] = 0;
  176.   }
  177.  
  178. /**
  179.  **  (sjk)++ Open temp file in R/W mode on the ST...
  180.  **/
  181. #if defined(atarist) && !defined(__MINT__)
  182.   filefd = open (XSTRING (args[1])->data, O_RDWR , 666);
  183. #else
  184.   filefd = open (XSTRING (args[1])->data, O_RDONLY, 0);
  185. #endif
  186.  
  187.   if (filefd < 0)
  188.     {
  189.       report_file_error ("Opening process input file", Fcons (args[1], Qnil));
  190.     }
  191.   /* Search for program; barf if not found.  */
  192. /**
  193.  **  (sjk)++ When searching for executables check some obvious extensions.
  194.  **/
  195. #if defined(atarist)
  196.   openp (Vexec_path, args[0], ":ttp:tos:prg", &path, 1);
  197. #else
  198.   openp (Vexec_path, args[0], "", &path, 1);
  199. #endif
  200.  
  201.   if (NULL (path))
  202.     {
  203.       close (filefd);
  204.       report_file_error ("Searching for program", Fcons (args[0], Qnil));
  205.     }
  206.   new_argv[0] = XSTRING (path)->data;
  207.  
  208.   if (XTYPE (buffer) == Lisp_Int)
  209. #ifdef VMS
  210.     fd[1] = open ("NLA0:", 0), fd[0] = -1;
  211. #else
  212.     fd[1] = open ("/dev/null", O_WRONLY), fd[0] = -1;
  213. #endif /* not VMS */
  214.   else
  215.     {
  216.       pipe (fd);
  217. #if 0
  218.       /* Replaced by close_process_descs */
  219.       set_exclusive_use (fd[0]);
  220. #endif
  221.     }
  222.  
  223.   {
  224.     /* child_setup must clobber environ in systems with true vfork.
  225.        Protect it from permanent change.  */
  226.     register char **save_environ = environ;
  227.     register int fd1 = fd[1];
  228.     char **env;
  229.  
  230. #ifdef MAINTAIN_ENVIRONMENT
  231.     env = (char **) alloca (size_of_current_environ ());
  232.     get_current_environ (env);
  233. #else
  234.     env = environ;
  235. #endif /* MAINTAIN_ENVIRONMENT */
  236.  
  237.     pid = vfork ();
  238. #ifdef BSD4_1
  239.     /* cause SIGCHLD interrupts to look for this pid. */
  240.     synch_process_pid = pid;
  241. #endif /* BSD4_1 */
  242.  
  243.     if (pid == 0)
  244.       {
  245. /**
  246.  **  (sjk)++ Avoid some excess file closes.
  247.  **/
  248. #if !defined(atarist) || defined(__MINT__)
  249.     if (fd[0] >= 0)
  250.       close (fd[0]);
  251. #ifdef USG
  252. #ifdef HAVE_PTYS
  253.     setpgrp ();
  254. #endif
  255. #endif
  256. #endif /* !defined(atarist) */
  257.  
  258.     child_setup (filefd, fd1, fd1, new_argv, env);
  259.       }
  260.  
  261.     environ = save_environ;
  262.  
  263.     close (filefd);
  264.     close (fd1);
  265.   }
  266.  
  267.   if (pid < 0)
  268.     {
  269. /**
  270.  **  (sjk)++ Make sure both end of pipe get closed if vfork() fails
  271.  **/
  272. #if defined(atarist) && !defined(__MINT__)
  273.       close (fd[1]);
  274. #endif
  275.  
  276.       close (fd[0]);
  277.       report_file_error ("Doing vfork", Qnil);
  278.     }
  279.  
  280.   if (XTYPE (buffer) == Lisp_Int)
  281.     {
  282. #ifndef subprocesses
  283.       wait_without_blocking ();
  284. #endif subprocesses
  285.       return Qnil;
  286.     }
  287.  
  288.   record_unwind_protect (call_process_cleanup,
  289.              Fcons (make_number (fd[0]), make_number (pid)));
  290.  
  291.  
  292.   if (XTYPE (buffer) == Lisp_Buffer)
  293.     Fset_buffer (buffer);
  294.  
  295.   immediate_quit = 1;
  296.   QUIT;
  297.  
  298.   {
  299.     register int nread;
  300.  
  301.     while ((nread = read (fd[0], buf, sizeof buf)) > 0)
  302.       {
  303.     immediate_quit = 0;
  304.     if (!NULL (buffer))
  305.       insert (buf, nread);
  306.     if (!NULL (display) && FROM_KBD)
  307.       redisplay_preserve_echo_area ();
  308.     immediate_quit = 1;
  309.     QUIT;
  310.       }
  311.   }
  312.  
  313. /**
  314.  **  (sjk)++ here we close the write side of the pipe. 
  315.  **/
  316. #if defined(atarist) && !defined(__MINT__)
  317.   close(fd[0]);
  318. #endif
  319.  
  320.   /* Wait for it to terminate, unless it already has.  */
  321.   wait_for_termination (pid);
  322.  
  323.   immediate_quit = 0;
  324.  
  325.   set_buffer_internal (old);
  326.  
  327.   unbind_to (count);
  328.  
  329.   return Qnil;
  330. }
  331.  
  332. DEFUN ("call-process-region", Fcall_process_region, Scall_process_region,
  333.   3, MANY, 0,
  334.   "Send text from START to END to a process running PROGRAM.\n\
  335. Delete the text if DELETE is non-nil.\n\
  336. Put output in BUFFER, before point.  nil => discard it, t => current buffer.\n\
  337. Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
  338. Remaining args are passed to PROGRAM at startup as command args.\n\
  339. This function normally waits for the process to terminate;\n\
  340. if you quit, the process is killed.")
  341.   (nargs, args)
  342.      int nargs;
  343.      register Lisp_Object *args;
  344. {
  345.   register Lisp_Object filename_string, start, end;
  346.  
  347. /**
  348.  **  (sjk)++  ask for a temp file name.
  349.  **/
  350. #if !defined(atarist)
  351.   char tempfile[20];
  352. #endif
  353. #if defined(atarist)
  354.   tmpnam(at_tmpname);
  355. #else
  356.   strcpy (tempfile, "/tmp/emacsXXXXXX");
  357.   mktemp (tempfile);
  358. #endif
  359. #if !defined(atarist)
  360.   filename_string = build_string (tempfile);
  361. #else
  362.   filename_string = build_string (at_tmpname);
  363. #endif
  364.  
  365.   start = args[0];
  366.   end = args[1];
  367.   Fwrite_region (start, end, filename_string, Qnil, Qlambda);
  368.  
  369.   if (!NULL (args[3]))
  370.     Fdelete_region (start, end);
  371.  
  372.   args[3] = filename_string;
  373.   Fcall_process (nargs - 2, args + 2);
  374.  
  375. /**
  376.  **  (sjk)++ on the ST unlink the correct name...
  377.  **/
  378. #if !defined(atarist)
  379.   unlink (tempfile);
  380. #else
  381.   unlink(at_tmpname);
  382. #endif
  383.  
  384.   return Qnil;
  385. }
  386.  
  387. /* This is the last thing run in a newly forked inferior
  388.    either synchronous or asynchronous.
  389.    Copy descriptors IN, OUT and ERR as descriptors 0, 1 and 2.
  390.    Initialize inferior's priority, pgrp, connected dir and environment.
  391.    then exec another program based on new_argv.
  392.  
  393.    This function may change environ for the superior process.
  394.    Therefore, the superior process must save and restore the value
  395.    of environ around the vfork and the call to this function.
  396.  
  397.    ENV is the environment */
  398.  
  399. child_setup (in, out, err, new_argv, env)
  400.      int in, out, err;
  401.      register char **new_argv;
  402.      char **env;
  403. {
  404.   register int pid = getpid();
  405.  
  406. /**
  407.  **  (sjk)++ No need to set proirity or close process descriptors...
  408.  **/
  409. #if !defined(atarist)
  410.   setpriority (PRIO_PROCESS, pid, 0);
  411. #endif /* atarist */
  412.  
  413. #ifdef subprocesses
  414.   /* Close Emacs's descriptors that this process should not have.  */
  415.   close_process_descs ();
  416. #endif
  417.  
  418.   /* Note that use of alloca is always safe here.  It's obvious for systems
  419.      that do not have true vfork or that have true (stack) alloca.
  420.      If using vfork and C_ALLOCA it is safe because that changes
  421.      the superior's static variables as if the superior had done alloca
  422.      and will be cleaned up in the usual way.  */
  423.  
  424.   if (XTYPE (current_buffer->directory) == Lisp_String)
  425.     {
  426.       register unsigned char *temp;
  427.       register int i;
  428.  
  429.       i = XSTRING (current_buffer->directory)->size;
  430.       temp = (unsigned char *) alloca (i + 2);
  431.       bcopy (XSTRING (current_buffer->directory)->data, temp, i);
  432.       if (temp[i - 1] != '/') temp[i++] = '/';
  433.       temp[i] = 0;
  434.       chdir (temp);
  435.     }
  436.  
  437. #ifndef MAINTAIN_ENVIRONMENT
  438.   /* Set `env' to a vector of the strings in Vprocess_environment.  */
  439.   {
  440.     register Lisp_Object tem;
  441.     register char **new_env;
  442.     register int new_length;
  443.  
  444.     new_length = 0;
  445.     for (tem = Vprocess_environment;
  446.      (XTYPE (tem) == Lisp_Cons
  447.       && XTYPE (XCONS (tem)->car) == Lisp_String);
  448.      tem = XCONS (tem)->cdr)
  449.       new_length++;
  450.  
  451.     /* new_length + 1 to include terminating 0 */
  452.     env = new_env = (char **) alloca ((new_length + 1) * sizeof (char *));
  453.  
  454.     /* Copy the env strings into new_env.  */
  455.     for (tem = Vprocess_environment;
  456.      (XTYPE (tem) == Lisp_Cons
  457.       && XTYPE (XCONS (tem)->car) == Lisp_String);
  458.      tem = XCONS (tem)->cdr)
  459.       *new_env++ = (char *) XSTRING (XCONS (tem)->car)->data;
  460.     *new_env = 0;
  461.   }
  462. #endif /* Not MAINTAIN_ENVIRONMENT */
  463.  
  464.   close (0);
  465.   close (1);
  466.   close (2);
  467.  
  468.   dup2 (in, 0);
  469.   dup2 (out, 1);
  470.   dup2 (err, 2);
  471. #ifdef __MINT__
  472.   dup2 (in, -1);        /* Controlling terminal (erlingh)++ */
  473. #endif
  474.   close (in);
  475.   close (out);
  476.   close (err);
  477.  
  478. #ifdef USG
  479. #ifndef HAVE_PTYS
  480.   setpgrp ();            /* No arguments but equivalent in this case */
  481. #endif
  482. #else
  483.   setpgrp (pid, pid);
  484. #endif /* USG */
  485.   setpgrp_of_tty (pid);
  486.  
  487. #ifdef vipc
  488.   something missing here;
  489. #endif vipc
  490.  
  491.   /* execvp does not accept an environment arg so the only way
  492.      to pass this environment is to set environ.  Our caller
  493.      is responsible for restoring the ambient value of environ.  */
  494.   environ = env;
  495.   execvp (new_argv[0], new_argv);
  496.  
  497.   write (1, "Couldn't exec the program ", 26);
  498.   write (1, new_argv[0], strlen (new_argv[0]));
  499.   _exit (1);
  500. }
  501.  
  502. init_callproc ()
  503. {
  504.   register char * sh;
  505.   extern char **environ;
  506.   register char **envp;
  507.   Lisp_Object execdir;
  508.  
  509.   /* Turn PATH_EXEC into a path.  `==' is just a string which we know
  510.      will not be the name of an environment variable.  */
  511.   Vexec_path = decode_env_path ("==", PATH_EXEC);
  512.   Vexec_directory = Ffile_name_as_directory (Fcar (Vexec_path));
  513.   Vexec_path = nconc2 (decode_env_path ("PATH", ""), Vexec_path);
  514.  
  515.   execdir = Fdirectory_file_name (Vexec_directory);
  516.   if (access (XSTRING (execdir)->data, 0) < 0)
  517.     {
  518.       printf ("Warning: executable/documentation dir (%s) does not exist.\n",
  519.           XSTRING (Vexec_directory)->data);
  520.       sleep (2);
  521.     }
  522.  
  523.   sh = (char *) egetenv ("SHELL");
  524.   Vshell_file_name = build_string (sh ? sh : "/bin/sh");
  525.  
  526. #ifndef MAINTAIN_ENVIRONMENT
  527.   /* The equivalent of this operation was done
  528.      in init_environ in environ.c if MAINTAIN_ENVIRONMENT */
  529.   Vprocess_environment = Qnil;
  530. #ifndef CANNOT_DUMP
  531.   if (initialized)
  532. #endif
  533.     for (envp = environ; *envp; envp++)
  534.       Vprocess_environment = Fcons (build_string (*envp),
  535.                     Vprocess_environment);
  536. #endif /* MAINTAIN_ENVIRONMENT */
  537. }
  538.  
  539. syms_of_callproc ()
  540. {
  541.   DEFVAR_LISP ("shell-file-name", &Vshell_file_name,
  542.     "*File name to load inferior shells from.\n\
  543. Initialized from the SHELL environment variable.");
  544.  
  545.   DEFVAR_LISP ("exec-path", &Vexec_path,
  546.     "*List of directories to search programs to run in subprocesses.\n\
  547. Each element is a string (directory name) or nil (try default directory).");
  548.  
  549.   DEFVAR_LISP ("exec-directory", &Vexec_directory,
  550.     "Directory that holds programs that come with GNU Emacs,\n\
  551. intended for Emacs to invoke.");
  552.  
  553. #ifndef MAINTAIN_ENVIRONMENT
  554.   DEFVAR_LISP ("process-environment", &Vprocess_environment,
  555.     "List of strings to append to environment of subprocesses that are started.\n\
  556. Each string should have the format ENVVARNAME=VALUE.");
  557. #endif
  558.  
  559.   defsubr (&Scall_process);
  560.   defsubr (&Scall_process_region);
  561. }
  562.