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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 10 - (hide annotations) (download) (as text)
Sat Nov 13 16:40:11 2004 UTC (17 years, 7 months ago) by aw0a
Original Path: trunk/tcltk98/interface/EnvVarProc.c
File MIME type: text/x-csrc
File size: 6072 byte(s)
try again to commit moving tcl stuff
1 aw0a 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 "interface/HelpProc.h"
42     #include "interface/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