[bpt/emacs.git] / src / environ.c

/* Environment-hacking for GNU Emacs subprocess
   Copyright (C) 1986 Free Software Foundation, Inc.

This file is part of GNU Emacs.

GNU Emacs is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 1, or (at your option)
any later version.

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with GNU Emacs; see the file COPYING.  If not, write to
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */


#include "config.h"
#include "lisp.h"

#ifdef MAINTAIN_ENVIRONMENT

#ifdef VMS
you lose -- this is un*x-only
#endif

/* alist of (name-string . value-string) */
Lisp_Object Venvironment_alist;
extern char **environ;

void
set_environment_alist (str, val)
     register Lisp_Object str, val;
{
  register Lisp_Object tem;

  tem = Fassoc (str, Venvironment_alist);
  if (NULL (tem))
    if (NULL (val))
      ;
    else
      Venvironment_alist = Fcons (Fcons (str, val), Venvironment_alist);
  else
    if (NULL (val))
      Venvironment_alist = Fdelq (tem, Venvironment_alist);
    else
      XCONS (tem)->cdr = val;
}


static void
initialize_environment_alist ()
{
  register unsigned char **e, *s;
  extern char *index ();

  for (e = (unsigned char **) environ; *e; e++)
    {
      s = (unsigned char *) index (*e, '=');
      if (s)
	set_environment_alist (make_string (*e, s - *e),
			       build_string (s + 1));
    }
}

\f
unsigned char *
getenv_1 (str, ephemeral)
     register unsigned char *str;
     int ephemeral;		/* if ephmeral, don't need to gc-proof */
{
  register Lisp_Object env;
  int len = strlen (str);

  for (env = Venvironment_alist; CONSP (env); env = XCONS (env)->cdr)
    {
      register Lisp_Object car = XCONS (env)->car;
      register Lisp_Object tem = XCONS (car)->car;

      if ((len == XSTRING (tem)->size) &&
	  (!bcmp (str, XSTRING (tem)->data, len)))
	{
	  /* Found it in the lisp environment */
	  tem = XCONS (car)->cdr;
	  if (ephemeral)
	    /* Caller promises that gc won't make him lose */
	    return XSTRING (tem)->data;
	  else
	    {
	      register unsigned char **e;
	      unsigned char *s;
	      int ll = XSTRING (tem)->size;

	      /* Look for element in the original unix environment */
	      for (e = (unsigned char **) environ; *e; e++)
		if (!bcmp (str, *e, len) && *(*e + len) == '=')
		  {
		    s = *e + len + 1;
		    if (strlen (s) >= ll)
		      /* User hasn't either hasn't munged it or has set it
			 to something shorter -- we don't have to cons */
		      goto copy;
		    else
		      goto cons;
		  };
	    cons:
	      /* User has setenv'ed it to a diferent value, and our caller
		 isn't guaranteeing that he won't stash it away somewhere.
		 We can't just return a pointer to the lisp string, as that
		 will be corrupted when gc happens.  So, we cons (in such
		 a way that it can't be freed -- though this isn't such a
		 problem since the only callers of getenv (as opposed to
		 those of egetenv) are very early, before the user -could-
		 have frobbed the environment. */
	      s = (unsigned char *) xmalloc (ll + 1);
	    copy:
	      bcopy (XSTRING (tem)->data, s, ll + 1);
	      return (s);
	    }
	}
    }
  return ((unsigned char *) 0);
}

/* unsigned  -- stupid delcaration in lisp.h */ char *
getenv (str)
     register unsigned char *str;
{
  return ((char *) getenv_1 (str, 0));
}

unsigned char *
egetenv (str)
     register unsigned char *str;
{
  return (getenv_1 (str, 1));
}
\f

#if (1 == 1) /* use caller-alloca versions, rather than callee-malloc */
int
size_of_current_environ ()
{
  register int size;
  Lisp_Object tem;

  tem = Flength (Venvironment_alist);
  
  size = (XINT (tem) + 1) * sizeof (unsigned char *);
  /* + 1 for environment-terminating 0 */

  for (tem = Venvironment_alist; !NULL (tem); tem = XCONS (tem)->cdr)
    {
      register Lisp_Object str, val;

      str = XCONS (XCONS (tem)->car)->car;
      val = XCONS (XCONS (tem)->car)->cdr;

      size += (XSTRING (str)->size +
	       XSTRING (val)->size +
	       2);	/* 1 for '=', 1 for '\000' */
    }
  return size;
}

void
get_current_environ (memory_block)
     unsigned char **memory_block;
{
  register unsigned char **e, *s;
  register int len;
  register Lisp_Object tem;

  e = memory_block;

  tem = Flength (Venvironment_alist);
  
  s = (unsigned char *) memory_block
		+ (XINT (tem) + 1) * sizeof (unsigned char *);

  for (tem = Venvironment_alist; !NULL (tem); tem = XCONS (tem)->cdr)
    {
      register Lisp_Object str, val;

      str = XCONS (XCONS (tem)->car)->car;
      val = XCONS (XCONS (tem)->car)->cdr;

      *e++ = s;
      len = XSTRING (str)->size;
      bcopy (XSTRING (str)->data, s, len);
      s += len;
      *s++ = '=';
      len = XSTRING (val)->size;
      bcopy (XSTRING (val)->data, s, len);
      s += len;
      *s++ = '\000';
    }
  *e = 0;
}

#else
/* dead code (this function mallocs, caller frees) superseded by above (which allows caller to use alloca) */
unsigned char **
current_environ ()
{
  unsigned char **env;
  register unsigned char **e, *s;
  register int len, env_len;
  Lisp_Object tem;
  Lisp_Object str, val;

  tem = Flength (Venvironment_alist);

  env_len = (XINT (tem) + 1) * sizeof (char *);
  /* + 1 for terminating 0 */

  len = 0;
  for (tem = Venvironment_alist; !NULL (tem); tem = XCONS (tem)->cdr)
    {
      str = XCONS (XCONS (tem)->car)->car;
      val = XCONS (XCONS (tem)->car)->cdr;

      len += (XSTRING (str)->size +
	      XSTRING (val)->size +
	      2);
    }

  e = env = (unsigned char **) xmalloc (env_len + len);
  s = (unsigned char *) env + env_len;

  for (tem = Venvironment_alist; !NULL (tem); tem = XCONS (tem)->cdr)
    {
      str = XCONS (XCONS (tem)->car)->car;
      val = XCONS (XCONS (tem)->car)->cdr;

      *e++ = s;
      len = XSTRING (str)->size;
      bcopy (XSTRING (str)->data, s, len);
      s += len;
      *s++ = '=';
      len = XSTRING (val)->size;
      bcopy (XSTRING (val)->data, s, len);
      s += len;
      *s++ = '\000';
    }
  *e = 0;

  return env;
}

#endif /* dead code */

\f
DEFUN ("getenv", Fgetenv, Sgetenv, 1, 2, "sEnvironment variable: \np",
  "Return the value of environment variable VAR, as a string.\n\
When invoked interactively, print the value in the echo area.\n\
VAR is a string, the name of the variable,\n\
 or the symbol t, meaning to return an alist representing the\n\
 current environment.")
  (str, interactivep)
     Lisp_Object str, interactivep;
{
  Lisp_Object val;
  
  if (str == Qt)		/* If arg is t, return whole environment */
    return (Fcopy_alist (Venvironment_alist));

  CHECK_STRING (str, 0);
  val = Fcdr (Fassoc (str, Venvironment_alist));
  if (!NULL (interactivep))
    {
      if (NULL (val))
	message ("%s not defined in environment", XSTRING (str)->data);
      else
	message ("\"%s\"", XSTRING (val)->data);
    }
  return val;
}

DEFUN ("setenv", Fsetenv, Ssetenv, 1, 2,
  "sEnvironment variable: \nsSet %s to value: ",
  "Set the value of environment variable VAR to VALUE.\n\
Both args must be strings.  Returns VALUE.")
  (str, val)
     Lisp_Object str;
     Lisp_Object val;
{
  Lisp_Object tem;

  CHECK_STRING (str, 0);
  if (!NULL (val))
    CHECK_STRING (val, 0);

  set_environment_alist (str, val);
  return val;
}
\f

syms_of_environ ()
{
  staticpro (&Venvironment_alist);
  defsubr (&Ssetenv);
  defsubr (&Sgetenv);
}

init_environ ()
{
  Venvironment_alist = Qnil;
  initialize_environment_alist ();
}

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