![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to environ.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Apple XNU] / GNUtools / emacs / src|
Return to environ.c CVS log | Up to [Apple XNU] / GNUtools / emacs / src |
1.1 root 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:
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:
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:
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: "Return the value of environment variable VAR, as a string.\n\
287: When invoked interactively, print the value in the echo area.\n\
288: VAR is a string, the name of the variable.")
289: (str, val)
290: Lisp_Object str;
291: Lisp_Object val;
292: {
293: Lisp_Object tem;
294:
295: CHECK_STRING (str, 0);
296: if (!NULL (val))
297: CHECK_STRING (val, 0);
298:
299: set_environment_alist (str, val);
300: return val;
301: }
302:
303:
304: syms_of_environ ()
305: {
306: staticpro (&Venvironment_alist);
307: defsubr (&Ssetenv);
308: defsubr (&Sgetenv);
309: }
310:
311: init_environ ()
312: {
313: Venvironment_alist = Qnil;
314: initialize_environment_alist ();
315: }
316:
317: #endif /* MAINTAIN_ENVIRONMENT */
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.