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 */ |