Mercurial > emacs
comparison src/=environ.c @ 115:c7c930b84dbb
entered into RCS
author | Jim Blandy <jimb@redhat.com> |
---|---|
date | Mon, 12 Nov 1990 20:20:40 +0000 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
114:899728e6052a | 115:c7c930b84dbb |
---|---|
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 "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 | |
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 */ |