annotate src/=environ.c @ 13035:b8453eab5114

(indent-for-tab-command): Get the prefix arg and pass it along to indent-line-function if it isn't nil.
author Richard M. Stallman <rms@gnu.org>
date Thu, 14 Sep 1995 14:45:02 +0000
parents c7c930b84dbb
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
115
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1 /* Environment-hacking for GNU Emacs subprocess
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2 Copyright (C) 1986 Free Software Foundation, Inc.
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4 This file is part of GNU Emacs.
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6 GNU Emacs is free software; you can redistribute it and/or modify
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
7 it under the terms of the GNU General Public License as published by
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
8 the Free Software Foundation; either version 1, or (at your option)
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
9 any later version.
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
10
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
11 GNU Emacs is distributed in the hope that it will be useful,
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
14 GNU General Public License for more details.
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
15
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
16 You should have received a copy of the GNU General Public License
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
17 along with GNU Emacs; see the file COPYING. If not, write to
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
19
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
20
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
21 #include "config.h"
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
22 #include "lisp.h"
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
23
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
24 #ifdef MAINTAIN_ENVIRONMENT
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
25
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
26 #ifdef VMS
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
27 you lose -- this is un*x-only
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
28 #endif
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
29
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
30 /* alist of (name-string . value-string) */
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
31 Lisp_Object Venvironment_alist;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
32 extern char **environ;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
33
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
34 void
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
35 set_environment_alist (str, val)
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
36 register Lisp_Object str, val;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
37 {
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
38 register Lisp_Object tem;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
39
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
40 tem = Fassoc (str, Venvironment_alist);
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
41 if (NULL (tem))
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
42 if (NULL (val))
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
43 ;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
44 else
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
45 Venvironment_alist = Fcons (Fcons (str, val), Venvironment_alist);
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
46 else
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
47 if (NULL (val))
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
48 Venvironment_alist = Fdelq (tem, Venvironment_alist);
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
49 else
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
50 XCONS (tem)->cdr = val;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
51 }
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
52
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
53
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
54
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
55 static void
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
56 initialize_environment_alist ()
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
57 {
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
58 register unsigned char **e, *s;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
59 extern char *index ();
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
60
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
61 for (e = (unsigned char **) environ; *e; e++)
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
62 {
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
63 s = (unsigned char *) index (*e, '=');
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
64 if (s)
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
65 set_environment_alist (make_string (*e, s - *e),
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
66 build_string (s + 1));
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
67 }
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
68 }
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
69
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
70
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
71 unsigned char *
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
72 getenv_1 (str, ephemeral)
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
73 register unsigned char *str;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
74 int ephemeral; /* if ephmeral, don't need to gc-proof */
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
75 {
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
76 register Lisp_Object env;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
77 int len = strlen (str);
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
78
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
79 for (env = Venvironment_alist; CONSP (env); env = XCONS (env)->cdr)
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
80 {
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
81 register Lisp_Object car = XCONS (env)->car;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
82 register Lisp_Object tem = XCONS (car)->car;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
83
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
84 if ((len == XSTRING (tem)->size) &&
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
85 (!bcmp (str, XSTRING (tem)->data, len)))
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
86 {
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
87 /* Found it in the lisp environment */
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
88 tem = XCONS (car)->cdr;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
89 if (ephemeral)
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
90 /* Caller promises that gc won't make him lose */
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
91 return XSTRING (tem)->data;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
92 else
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
93 {
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
94 register unsigned char **e;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
95 unsigned char *s;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
96 int ll = XSTRING (tem)->size;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
97
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
98 /* Look for element in the original unix environment */
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
99 for (e = (unsigned char **) environ; *e; e++)
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
100 if (!bcmp (str, *e, len) && *(*e + len) == '=')
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
101 {
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
102 s = *e + len + 1;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
103 if (strlen (s) >= ll)
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
104 /* User hasn't either hasn't munged it or has set it
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
105 to something shorter -- we don't have to cons */
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
106 goto copy;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
107 else
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
108 goto cons;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
109 };
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
110 cons:
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
111 /* User has setenv'ed it to a diferent value, and our caller
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
112 isn't guaranteeing that he won't stash it away somewhere.
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
113 We can't just return a pointer to the lisp string, as that
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
114 will be corrupted when gc happens. So, we cons (in such
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
115 a way that it can't be freed -- though this isn't such a
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
116 problem since the only callers of getenv (as opposed to
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
117 those of egetenv) are very early, before the user -could-
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
118 have frobbed the environment. */
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
119 s = (unsigned char *) xmalloc (ll + 1);
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
120 copy:
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
121 bcopy (XSTRING (tem)->data, s, ll + 1);
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
122 return (s);
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
123 }
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
124 }
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
125 }
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
126 return ((unsigned char *) 0);
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
127 }
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
128
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
129 /* unsigned -- stupid delcaration in lisp.h */ char *
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
130 getenv (str)
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
131 register unsigned char *str;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
132 {
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
133 return ((char *) getenv_1 (str, 0));
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
134 }
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
135
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
136 unsigned char *
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
137 egetenv (str)
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
138 register unsigned char *str;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
139 {
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
140 return (getenv_1 (str, 1));
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
141 }
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
142
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
143
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
144 #if (1 == 1) /* use caller-alloca versions, rather than callee-malloc */
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
145 int
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
146 size_of_current_environ ()
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
147 {
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
148 register int size;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
149 Lisp_Object tem;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
150
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
151 tem = Flength (Venvironment_alist);
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
152
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
153 size = (XINT (tem) + 1) * sizeof (unsigned char *);
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
154 /* + 1 for environment-terminating 0 */
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
155
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
156 for (tem = Venvironment_alist; !NULL (tem); tem = XCONS (tem)->cdr)
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
157 {
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
158 register Lisp_Object str, val;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
159
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
160 str = XCONS (XCONS (tem)->car)->car;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
161 val = XCONS (XCONS (tem)->car)->cdr;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
162
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
163 size += (XSTRING (str)->size +
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
164 XSTRING (val)->size +
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
165 2); /* 1 for '=', 1 for '\000' */
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
166 }
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
167 return size;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
168 }
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
169
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
170 void
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
171 get_current_environ (memory_block)
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
172 unsigned char **memory_block;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
173 {
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
174 register unsigned char **e, *s;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
175 register int len;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
176 register Lisp_Object tem;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
177
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
178 e = memory_block;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
179
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
180 tem = Flength (Venvironment_alist);
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
181
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
182 s = (unsigned char *) memory_block
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
183 + (XINT (tem) + 1) * sizeof (unsigned char *);
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
184
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
185 for (tem = Venvironment_alist; !NULL (tem); tem = XCONS (tem)->cdr)
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
186 {
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
187 register Lisp_Object str, val;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
188
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
189 str = XCONS (XCONS (tem)->car)->car;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
190 val = XCONS (XCONS (tem)->car)->cdr;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
191
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
192 *e++ = s;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
193 len = XSTRING (str)->size;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
194 bcopy (XSTRING (str)->data, s, len);
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
195 s += len;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
196 *s++ = '=';
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
197 len = XSTRING (val)->size;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
198 bcopy (XSTRING (val)->data, s, len);
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
199 s += len;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
200 *s++ = '\000';
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
201 }
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
202 *e = 0;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
203 }
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
204
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
205 #else
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
206 /* dead code (this function mallocs, caller frees) superseded by above (which allows caller to use alloca) */
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
207 unsigned char **
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
208 current_environ ()
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
209 {
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
210 unsigned char **env;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
211 register unsigned char **e, *s;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
212 register int len, env_len;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
213 Lisp_Object tem;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
214 Lisp_Object str, val;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
215
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
216 tem = Flength (Venvironment_alist);
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
217
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
218 env_len = (XINT (tem) + 1) * sizeof (char *);
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
219 /* + 1 for terminating 0 */
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
220
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
221 len = 0;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
222 for (tem = Venvironment_alist; !NULL (tem); tem = XCONS (tem)->cdr)
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
223 {
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
224 str = XCONS (XCONS (tem)->car)->car;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
225 val = XCONS (XCONS (tem)->car)->cdr;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
226
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
227 len += (XSTRING (str)->size +
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
228 XSTRING (val)->size +
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
229 2);
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
230 }
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
231
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
232 e = env = (unsigned char **) xmalloc (env_len + len);
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
233 s = (unsigned char *) env + env_len;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
234
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
235 for (tem = Venvironment_alist; !NULL (tem); tem = XCONS (tem)->cdr)
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
236 {
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
237 str = XCONS (XCONS (tem)->car)->car;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
238 val = XCONS (XCONS (tem)->car)->cdr;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
239
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
240 *e++ = s;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
241 len = XSTRING (str)->size;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
242 bcopy (XSTRING (str)->data, s, len);
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
243 s += len;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
244 *s++ = '=';
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
245 len = XSTRING (val)->size;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
246 bcopy (XSTRING (val)->data, s, len);
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
247 s += len;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
248 *s++ = '\000';
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
249 }
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
250 *e = 0;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
251
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
252 return env;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
253 }
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
254
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
255 #endif /* dead code */
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
256
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
257
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
258 DEFUN ("getenv", Fgetenv, Sgetenv, 1, 2, "sEnvironment variable: \np",
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
259 "Return the value of environment variable VAR, as a string.\n\
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
260 When invoked interactively, print the value in the echo area.\n\
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
261 VAR is a string, the name of the variable,\n\
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
262 or the symbol t, meaning to return an alist representing the\n\
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
263 current environment.")
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
264 (str, interactivep)
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
265 Lisp_Object str, interactivep;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
266 {
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
267 Lisp_Object val;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
268
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
269 if (str == Qt) /* If arg is t, return whole environment */
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
270 return (Fcopy_alist (Venvironment_alist));
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
271
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
272 CHECK_STRING (str, 0);
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
273 val = Fcdr (Fassoc (str, Venvironment_alist));
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
274 if (!NULL (interactivep))
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
275 {
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
276 if (NULL (val))
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
277 message ("%s not defined in environment", XSTRING (str)->data);
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
278 else
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
279 message ("\"%s\"", XSTRING (val)->data);
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
280 }
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
281 return val;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
282 }
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
283
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
284 DEFUN ("setenv", Fsetenv, Ssetenv, 1, 2,
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
285 "sEnvironment variable: \nsSet %s to value: ",
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
286 "Set the value of environment variable VAR to VALUE.\n\
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
287 Both args must be strings. Returns VALUE.")
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
288 (str, val)
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
289 Lisp_Object str;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
290 Lisp_Object val;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
291 {
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
292 Lisp_Object tem;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
293
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
294 CHECK_STRING (str, 0);
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
295 if (!NULL (val))
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
296 CHECK_STRING (val, 0);
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
297
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
298 set_environment_alist (str, val);
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
299 return val;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
300 }
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
301
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
302
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
303 syms_of_environ ()
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
304 {
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
305 staticpro (&Venvironment_alist);
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
306 defsubr (&Ssetenv);
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
307 defsubr (&Sgetenv);
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
308 }
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
309
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
310 init_environ ()
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
311 {
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
312 Venvironment_alist = Qnil;
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
313 initialize_environment_alist ();
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
314 }
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
315
c7c930b84dbb entered into RCS
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
316 #endif /* MAINTAIN_ENVIRONMENT */