/[ascend]/trunk/tcltk98/generic/interface/EnvVarProc.c
ViewVC logotype

Contents of /trunk/tcltk98/generic/interface/EnvVarProc.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 389 - (show annotations) (download) (as text)
Thu Mar 30 06:24:10 2006 UTC (16 years, 1 month ago) by johnpye
File MIME type: text/x-csrc
File size: 6050 byte(s)
Cleaning up #includes in the Tcl/Tk interface. Doing this
all as a group so that it can be reversed out if necessary.
1 /*
2 * Ascend Environment Variable Imitation Tcl interface
3 * by Ben Allan
4 * Created: 6/3/97
5 * Version: $Revision: 1.7 $
6 * Version control file: $RCSfile: EnvVarProc.c,v $
7 * Date last modified: $Date: 2003/08/23 18:43:06 $
8 * Last modified by: $Author: ballan $
9 *
10 * This file is part of the Ascend Language Interpreter.
11 *
12 * Copyright (C) 1997 Benjamin Andrew Allan
13 *
14 * The Ascend Language Interpreter is free software; you can redistribute
15 * it and/or modify it under the terms of the GNU General Public License as
16 * published by the Free Software Foundation; either version 2 of the
17 * License, or (at your option) any later version.
18 *
19 * The Ascend Language Interpreter is distributed in hope that it will be
20 * useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
21 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
22 * General Public License for more details.
23 *
24 * You should have received a copy of the GNU General Public License
25 * along with the program; if not, write to the Free Software Foundation,
26 * Inc., 675 Mass Ave, Cambridge, MA 02139 USA. Check the file named
27 * COPYING.
28 *
29 * This file exists because win32, among others, can't keep their
30 * POSIX compliance up. In particular, getting and setting
31 * environment vars is exceedingly unreliable.
32 * This file implements a general way to store and fetch multiple
33 * paths.
34 * It does not interact in any way the the Tcl global "env" array.
35 */
36
37 #include <tcl.h>
38 #include <utilities/ascConfig.h>
39 #include <utilities/ascMalloc.h>
40 #include <utilities/ascEnvVar.h>
41 #include "HelpProc.h"
42 #include "EnvVarProc.h"
43
44 #ifndef lint
45 CONST char *EnvVarProcID = "$Id: EnvVarProc.c,v 1.7 2003/08/23 18:43:06 ballan Exp $";
46 #endif
47
48 STDHLF(Asc_EnvVarCmd,(Asc_EnvVarCmdHL1, Asc_EnvVarCmdHL2,
49 Asc_EnvVarCmdHL3, Asc_EnvVarCmdHL4, Asc_EnvVarCmdHL5, Asc_EnvVarCmdHL6,
50 Asc_EnvVarCmdHL7, Asc_EnvVarCmdHL8, Asc_EnvVarCmdHL9, Asc_EnvVarCmdHL10,
51 HLFSTOP));
52
53 int Asc_EnvVarCmd(ClientData cdata, Tcl_Interp *interp,
54 int argc, CONST84 char *argv[])
55 {
56 char **envargv;
57 char *path;
58 int envargc;
59 int c;
60
61 ASCUSE;
62 if (argc <2) {
63 Asc_HelpGetUsage(interp,argv[0]);
64 return TCL_ERROR;
65 }
66 switch (argv[1][0]) {
67 case 'a':
68 /*
69 * append varname pathelement
70 */
71 if (argc != 4) {
72 Tcl_AppendResult(interp,"wrong number of args : ",
73 argv[0]," append var pathelement",
74 (char *)NULL);
75 return TCL_ERROR;
76 }
77 if (Asc_AppendPath(QUIET(argv[2]),QUIET(argv[3]))!=0) {
78 Tcl_AppendResult(interp,"error appending var ",argv[2]," with ",argv[4],
79 (char *)NULL);
80 return TCL_ERROR;
81 }
82 break;
83 case 'e':
84 /* export var
85 */
86 if (argc != 3) {
87 Tcl_AppendResult(interp,"wrong number of args : ",
88 argv[0]," export var",
89 (char *)NULL);
90 return TCL_ERROR;
91 }
92 path = Asc_GetEnv(QUIET(argv[2]));
93 if (path !=NULL) {
94 Tcl_SetVar2(interp,"env",argv[2],path,TCL_GLOBAL_ONLY);
95 ascfree(path);
96 } else {
97 Tcl_AppendResult(interp,"export ascend environment var not found : ",
98 argv[0],argv[1],argv[2],
99 (char *)NULL);
100 return TCL_ERROR;
101 }
102 break;
103 case 'g':
104 /* get var
105 */
106 if (argc != 3) {
107 Tcl_AppendResult(interp,"wrong number of args : ",
108 argv[0]," get var",
109 (char *)NULL);
110 return TCL_ERROR;
111 }
112 path = Asc_GetEnv(QUIET(argv[2]));
113 if (path == NULL) {
114 Tcl_AppendResult(interp,"ascend environment var not found : ",
115 argv[0],argv[1],argv[2],
116 (char *)NULL);
117 return TCL_ERROR;
118 }
119 Tcl_AppendResult(interp,path, (char *)NULL);
120 ascfree(path);
121 break;
122 case 'i':
123 /* import var
124 */
125 if (argc != 3) {
126 Tcl_AppendResult(interp,"wrong number of args : ",
127 argv[0]," import var",
128 (char *)NULL);
129 return TCL_ERROR;
130 }
131 if (Asc_ImportPathList(argv[2])!=0) {
132 Tcl_AppendResult(interp,"C environment var not found : ",
133 argv[0],argv[1],argv[2],
134 (char *)NULL);
135 return TCL_ERROR;
136 }
137 break;
138 case 'l':
139 /* list var
140 */
141 if (argc != 3) {
142 Tcl_AppendResult(interp,"wrong number of args : ",
143 argv[0]," list var",
144 (char *)NULL);
145 return TCL_ERROR;
146 }
147 envargv = Asc_GetPathList(QUIET(argv[2]),&envargc);
148 if (envargv==NULL || envargc <1) {
149 Tcl_AppendResult(interp,"ascend environment var not found : ",
150 argv[0],argv[1],argv[2],
151 (char *)NULL);
152 return TCL_ERROR;
153 }
154 for (c = 0; c < envargc; c++) {
155 Tcl_AppendElement(interp,envargv[c]);
156 }
157 ascfree(envargv);
158 break;
159 case 'n':
160 /* names
161 */
162 if (argc != 2) {
163 Tcl_AppendResult(interp,"wrong number of args : ",
164 argv[0]," names",
165 (char *)NULL);
166 return TCL_ERROR;
167 }
168 envargv = Asc_EnvNames(&envargc);
169 if (envargv==NULL || envargc <1) {
170 Tcl_AppendElement(interp,"");
171 } else {
172 for (c = 0; c < envargc; c++) {
173 Tcl_AppendElement(interp,envargv[c]);
174 }
175 ascfree(envargv);
176 }
177 break;
178 case 'p':
179 /* put input_string
180 */
181 if (argc != 3) {
182 Tcl_AppendResult(interp,"wrong number of args : ",
183 argv[0]," put putenv_string",
184 (char *)NULL);
185 return TCL_ERROR;
186 }
187 if (Asc_PutEnv(QUIET(argv[2]))!=0) {
188 Tcl_AppendResult(interp,"error in processing: ",
189 argv[0],argv[1],argv[2],
190 (char *)NULL);
191 return TCL_ERROR;
192 }
193 break;
194 case 's':
195 /* set var path
196 */
197 if (argc != 4) {
198 Tcl_AppendResult(interp,"wrong number of args : ",
199 argv[0]," set var path",
200 (char *)NULL);
201 return TCL_ERROR;
202 }
203 if (Asc_SetPathList(argv[2],argv[3])!=0) {
204 Tcl_AppendResult(interp,"error in processing: ",
205 argv[0],argv[1],argv[2], argv[3],
206 (char *)NULL);
207 return TCL_ERROR;
208 }
209 break;
210 default:
211 Asc_HelpGetUsage(interp,argv[0]);
212 return TCL_ERROR;
213 }
214 return TCL_OK;
215 }

john.pye@anu.edu.au
ViewVC Help
Powered by ViewVC 1.1.22