home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / lucid / lemacs-19.6 / src / environ.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-02-14  |  7.5 KB  |  315 lines
  1. /* Environment-hacking for GNU Emacs subprocess
  2.    Copyright (C) 1986-1993 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 2, 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. #include "config.h"
  22. #include "lisp.h"
  23.  
  24. #ifdef MAINTAIN_ENVIRONMENT
  25.  
  26. #ifdef VMS
  27. you lose -- this is un*x-only
  28. #endif
  29.  
  30. /* alist of (name-string . value-string) */
  31. Lisp_Object Venvironment_alist;
  32. extern char **environ;
  33.  
  34. static void
  35. set_environment_alist (str, val)
  36.      register Lisp_Object str, val;
  37. {
  38.   register Lisp_Object tem;
  39.  
  40.   tem = Fassoc (str, Venvironment_alist);
  41.   if (NILP (tem))
  42.     if (NILP (val))
  43.       ;
  44.     else
  45.       Venvironment_alist = Fcons (Fcons (str, val), Venvironment_alist);
  46.   else
  47.     if (NILP (val))
  48.       Venvironment_alist = Fdelq (tem, Venvironment_alist);
  49.     else
  50.       XCONS (tem)->cdr = val;
  51. }
  52.  
  53.  
  54.  
  55. static void
  56. initialize_environment_alist ()
  57. {
  58.   register char **e, *s;
  59.  
  60.   for (e = (char **) environ; *e; e++)
  61.     {
  62.       s = (char *) strchr (*e, '=');
  63.       if (s)
  64.     set_environment_alist (make_string (*e, s - *e),
  65.                    build_string (s + 1));
  66.     }
  67. }
  68.  
  69.  
  70. static char *
  71. getenv_1 (str, ephemeral)
  72.      register const char *str;
  73.      int ephemeral;        /* if ephmeral, don't need to gc-proof */
  74. {
  75.   register Lisp_Object env;
  76.   int len = strlen ((char *) str);
  77.  
  78.   for (env = Venvironment_alist; CONSP (env); env = XCONS (env)->cdr)
  79.     {
  80.       register Lisp_Object car = XCONS (env)->car;
  81.       register Lisp_Object tem = XCONS (car)->car;
  82.  
  83.       if ((len == XSTRING (tem)->size) &&
  84.       (!memcmp (str, XSTRING (tem)->data, len)))
  85.     {
  86.       /* Found it in the lisp environment */
  87.       tem = XCONS (car)->cdr;
  88.       if (ephemeral)
  89.         /* Caller promises that gc won't make him lose */
  90.         return (char*) XSTRING (tem)->data;
  91.       else
  92.         {
  93.           register unsigned char **e;
  94.           unsigned char *s;
  95.           int ll = XSTRING (tem)->size;
  96.  
  97.           /* Look for element in the original unix environment */
  98.           for (e = (unsigned char **) environ; *e; e++)
  99.         if (!memcmp (str, *e, len) && *(*e + len) == '=')
  100.           {
  101.             s = *e + len + 1;
  102.             if (strlen ((const char *)s) >= ll)
  103.               /* User hasn't either hasn't munged it or has set it
  104.              to something shorter -- we don't have to cons */
  105.               goto copy;
  106.             else
  107.               goto cons;
  108.           };
  109.         cons:
  110.           /* User has setenv'ed it to a diferent value, and our caller
  111.          isn't guaranteeing that he won't stash it away somewhere.
  112.          We can't just return a pointer to the lisp string, as that
  113.          will be corrupted when gc happens.  So, we cons (in such
  114.          a way that it can't be freed -- though this isn't such a
  115.          problem since the only callers of getenv (as opposed to
  116.          those of egetenv) are very early, before the user -could-
  117.          have frobbed the environment. */
  118.           s = (unsigned char *) xmalloc (ll + 1);
  119.         copy:
  120.           memcpy (s, XSTRING (tem)->data, ll + 1);
  121.           return ((char *) s);
  122.         }
  123.     }
  124.     }
  125.   return ((char *) 0);
  126. }
  127.  
  128. char *
  129. getenv (str)
  130.      register const char *str;
  131. {
  132.   return ((char *) getenv_1 (str, 0));
  133. }
  134.  
  135. char *
  136. egetenv (str)
  137.      register const char *str;
  138. {
  139.   return (getenv_1 (str, 1));
  140. }
  141.  
  142.  
  143. #if (1 == 1) /* use caller-alloca versions, rather than callee-malloc */
  144. int
  145. size_of_current_environ ()
  146. {
  147.   register int size;
  148.   Lisp_Object tem;
  149.  
  150.   tem = Flength (Venvironment_alist);
  151.   
  152.   size = (XINT (tem) + 1) * sizeof (unsigned char *);
  153.   /* + 1 for environment-terminating 0 */
  154.  
  155.   for (tem = Venvironment_alist; !NILP (tem); tem = XCONS (tem)->cdr)
  156.     {
  157.       register Lisp_Object str, val;
  158.  
  159.       str = XCONS (XCONS (tem)->car)->car;
  160.       val = XCONS (XCONS (tem)->car)->cdr;
  161.  
  162.       size += (XSTRING (str)->size +
  163.            XSTRING (val)->size +
  164.            2);    /* 1 for '=', 1 for '\000' */
  165.     }
  166.   return size;
  167. }
  168.  
  169. void
  170. get_current_environ (memory_block)
  171.      char **memory_block;
  172. {
  173.   register char **e, *s;
  174.   register int len;
  175.   register Lisp_Object tem;
  176.  
  177.   e = memory_block;
  178.  
  179.   tem = Flength (Venvironment_alist);
  180.   
  181.   s = (char *) memory_block + (XINT (tem) + 1) * sizeof (unsigned char *);
  182.  
  183.   for (tem = Venvironment_alist; !NILP (tem); tem = XCONS (tem)->cdr)
  184.     {
  185.       register Lisp_Object str, val;
  186.  
  187.       str = XCONS (XCONS (tem)->car)->car;
  188.       val = XCONS (XCONS (tem)->car)->cdr;
  189.  
  190.       *e++ = s;
  191.       len = XSTRING (str)->size;
  192.       memcpy (s, XSTRING (str)->data, len);
  193.       s += len;
  194.       *s++ = '=';
  195.       len = XSTRING (val)->size;
  196.       memcpy (s, XSTRING (val)->data, len);
  197.       s += len;
  198.       *s++ = '\000';
  199.     }
  200.   *e = 0;
  201. }
  202.  
  203. #else
  204. /* dead code (this function mallocs, caller frees) superseded by above (which allows caller to use alloca) */
  205. unsigned char **
  206. current_environ ()
  207. {
  208.   unsigned char **env;
  209.   register unsigned char **e, *s;
  210.   register int len, env_len;
  211.   Lisp_Object tem;
  212.   Lisp_Object str, val;
  213.  
  214.   tem = Flength (Venvironment_alist);
  215.  
  216.   env_len = (XINT (tem) + 1) * sizeof (char *);
  217.   /* + 1 for terminating 0 */
  218.  
  219.   len = 0;
  220.   for (tem = Venvironment_alist; !NILP (tem); tem = XCONS (tem)->cdr)
  221.     {
  222.       str = XCONS (XCONS (tem)->car)->car;
  223.       val = XCONS (XCONS (tem)->car)->cdr;
  224.  
  225.       len += (XSTRING (str)->size +
  226.           XSTRING (val)->size +
  227.           2);
  228.     }
  229.  
  230.   e = env = (unsigned char **) xmalloc (env_len + len);
  231.   s = (unsigned char *) env + env_len;
  232.  
  233.   for (tem = Venvironment_alist; !NILP (tem); tem = XCONS (tem)->cdr)
  234.     {
  235.       str = XCONS (XCONS (tem)->car)->car;
  236.       val = XCONS (XCONS (tem)->car)->cdr;
  237.  
  238.       *e++ = s;
  239.       len = XSTRING (str)->size;
  240.       bcopy (XSTRING (str)->data, s, len);
  241.       s += len;
  242.       *s++ = '=';
  243.       len = XSTRING (val)->size;
  244.       bcopy (XSTRING (val)->data, s, len);
  245.       s += len;
  246.       *s++ = '\000';
  247.     }
  248.   *e = 0;
  249.  
  250.   return env;
  251. }
  252.  
  253. #endif /* dead code */
  254.  
  255.  
  256. DEFUN ("getenv", Fgetenv, Sgetenv, 1, 2, "sEnvironment variable: \np",
  257.   "Return the value of environment variable VAR, as a string.\n\
  258. When invoked interactively, print the value in the echo area.\n\
  259. VAR is a string, the name of the variable,\n\
  260.  or the symbol t, meaning to return an alist representing the\n\
  261.  current environment.")
  262.   (str, interactivep)
  263.      Lisp_Object str, interactivep;
  264. {
  265.   Lisp_Object val;
  266.   
  267.   if (str == Qt)        /* If arg is t, return whole environment */
  268.     return (Fcopy_alist (Venvironment_alist));
  269.  
  270.   CHECK_STRING (str, 0);
  271.   val = Fcdr (Fassoc (str, Venvironment_alist));
  272.   if (!NILP (interactivep))
  273.     {
  274.       if (NILP (val))
  275.     message ("%s not defined in environment", XSTRING (str)->data);
  276.       else
  277.     message ("\"%s\"", XSTRING (val)->data);
  278.     }
  279.   return val;
  280. }
  281.  
  282. DEFUN ("setenv", Fsetenv, Ssetenv, 1, 2,
  283.   "sEnvironment variable: \nsSet %s to value: ",
  284.   "Set the value of environment variable VAR to VALUE.\n\
  285. Both args must be strings.  Returns VALUE.")
  286.   (str, val)
  287.      Lisp_Object str;
  288.      Lisp_Object val;
  289. {
  290.   CHECK_STRING (str, 0);
  291.   if (!NILP (val))
  292.     CHECK_STRING (val, 0);
  293.  
  294.   set_environment_alist (str, val);
  295.   return val;
  296. }
  297.  
  298.  
  299. void
  300. syms_of_environ ()
  301. {
  302.   staticpro (&Venvironment_alist);
  303.   defsubr (&Ssetenv);
  304.   defsubr (&Sgetenv);
  305. }
  306.  
  307. void
  308. init_environ ()
  309. {
  310.   Venvironment_alist = Qnil;
  311.   initialize_environment_alist ();
  312. }
  313.  
  314. #endif /* MAINTAIN_ENVIRONMENT */
  315.