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