]>
Commit | Line | Data |
---|---|---|
6a5fa4e0 MG |
1 | /* |
2 | * tclXgeneral.c -- | |
3 | * | |
4 | * Contains general extensions to the basic TCL command set. | |
5 | *----------------------------------------------------------------------------- | |
6 | * Copyright 1992 Karl Lehenbauer and Mark Diekhans. | |
7 | * | |
8 | * Permission to use, copy, modify, and distribute this software and its | |
9 | * documentation for any purpose and without fee is hereby granted, provided | |
10 | * that the above copyright notice appear in all copies. Karl Lehenbauer and | |
11 | * Mark Diekhans make no representations about the suitability of this | |
12 | * software for any purpose. It is provided "as is" without express or | |
13 | * implied warranty. | |
14 | *----------------------------------------------------------------------------- | |
15 | * $Id: tclXgeneral.c,v 2.0 1992/10/16 04:50:47 markd Rel $ | |
16 | *----------------------------------------------------------------------------- | |
17 | */ | |
18 | ||
19 | #include "tclxint.h" | |
20 | ||
21 | /* | |
22 | * These globals must be set by main for the information to be defined. | |
23 | */ | |
24 | ||
25 | char *tclxVersion = "?"; /* Extended Tcl version number. */ | |
26 | int tclxPatchlevel = 0; /* Extended Tcl patch level. */ | |
27 | ||
28 | char *tclAppName = NULL; /* Application name */ | |
29 | char *tclAppLongname = NULL; /* Long, natural language application name */ | |
30 | char *tclAppVersion = NULL; /* Version number of the application */ | |
31 | ||
32 | \f | |
33 | /* | |
34 | *----------------------------------------------------------------------------- | |
35 | * | |
36 | * Tcl_EchoCmd -- | |
37 | * Implements the TCL echo command: | |
38 | * echo str1 [str2..] | |
39 | * | |
40 | * Results: | |
41 | * Always returns TCL_OK. | |
42 | * | |
43 | *----------------------------------------------------------------------------- | |
44 | */ | |
45 | int | |
46 | Tcl_EchoCmd(clientData, interp, argc, argv) | |
47 | ClientData clientData; | |
48 | Tcl_Interp *interp; | |
49 | int argc; | |
50 | char **argv; | |
51 | { | |
52 | int idx; | |
53 | ||
54 | for (idx = 1; idx < argc; idx++) { | |
55 | fputs (argv [idx], stdout); | |
56 | if (idx < (argc - 1)) | |
57 | printf(" "); | |
58 | } | |
59 | printf("\n"); | |
60 | return TCL_OK; | |
61 | } | |
62 | \f | |
63 | /* | |
64 | *----------------------------------------------------------------------------- | |
65 | * | |
66 | * Tcl_InfoxCmd -- | |
67 | * Implements the TCL infox command: | |
68 | * infox option | |
69 | * | |
70 | *----------------------------------------------------------------------------- | |
71 | */ | |
72 | int | |
73 | Tcl_InfoxCmd (clientData, interp, argc, argv) | |
74 | ClientData clientData; | |
75 | Tcl_Interp *interp; | |
76 | int argc; | |
77 | char **argv; | |
78 | { | |
79 | if (argc != 2) { | |
80 | Tcl_AppendResult (interp, tclXWrongArgs, argv [0], | |
81 | " option", (char *) NULL); | |
82 | return TCL_ERROR; | |
83 | } | |
84 | ||
85 | if (STREQU ("version", argv [1])) { | |
86 | Tcl_SetResult (interp, tclxVersion, TCL_STATIC); | |
87 | } else if (STREQU ("patchlevel", argv [1])) { | |
88 | char numBuf [32]; | |
89 | sprintf (numBuf, "%d", tclxPatchlevel); | |
90 | Tcl_SetResult (interp, numBuf, TCL_VOLATILE); | |
91 | } else if (STREQU ("appname", argv [1])) { | |
92 | if (tclAppName != NULL) | |
93 | Tcl_SetResult (interp, tclAppName, TCL_STATIC); | |
94 | } else if (STREQU ("applongname", argv [1])) { | |
95 | if (tclAppLongname != NULL) | |
96 | Tcl_SetResult (interp, tclAppLongname, TCL_STATIC); | |
97 | } else if (STREQU ("appversion", argv [1])) { | |
98 | if (tclAppVersion != NULL) | |
99 | Tcl_SetResult (interp, tclAppVersion, TCL_STATIC); | |
100 | } else { | |
101 | Tcl_AppendResult (interp, "illegal option \"", argv [1], | |
102 | "\" expect one of: version, patchlevel, appname, ", | |
103 | "applongname, or appversion", (char *) NULL); | |
104 | return TCL_ERROR; | |
105 | } | |
106 | return TCL_OK; | |
107 | } | |
108 | \f | |
109 | /* | |
110 | *----------------------------------------------------------------------------- | |
111 | * | |
112 | * Tcl_LoopCmd -- | |
113 | * Implements the TCL loop command: | |
114 | * loop var start end [increment] command | |
115 | * | |
116 | * Results: | |
117 | * Standard TCL results. | |
118 | * | |
119 | *----------------------------------------------------------------------------- | |
120 | */ | |
121 | int | |
122 | Tcl_LoopCmd (dummy, interp, argc, argv) | |
123 | ClientData dummy; | |
124 | Tcl_Interp *interp; | |
125 | int argc; | |
126 | char **argv; | |
127 | { | |
128 | int result = TCL_OK; | |
129 | long i, first, limit, incr = 1; | |
130 | char *command; | |
131 | char itxt [12]; | |
132 | ||
133 | if ((argc < 5) || (argc > 6)) { | |
134 | Tcl_AppendResult (interp, tclXWrongArgs, argv [0], | |
135 | " var first limit [incr] command", (char *) NULL); | |
136 | return TCL_ERROR; | |
137 | } | |
138 | ||
139 | if (Tcl_GetLong (interp, argv[2], &first) != TCL_OK) | |
140 | return TCL_ERROR; | |
141 | if (Tcl_GetLong (interp, argv[3], &limit) != TCL_OK) | |
142 | return TCL_ERROR; | |
143 | if (argc == 5) | |
144 | command = argv[4]; | |
145 | else { | |
146 | if (Tcl_GetLong (interp, argv[4], &incr) != TCL_OK) | |
147 | return TCL_ERROR; | |
148 | command = argv[5]; | |
149 | } | |
150 | ||
151 | for (i = first; | |
152 | (((i < limit) && (incr > 0)) || ((i > limit) && (incr < 0))); | |
153 | i += incr) { | |
154 | ||
155 | sprintf (itxt,"%ld",i); | |
156 | if (Tcl_SetVar (interp, argv [1], itxt, TCL_LEAVE_ERR_MSG) == NULL) | |
157 | return TCL_ERROR; | |
158 | ||
159 | result = Tcl_Eval(interp, command, 0, (char **) NULL); | |
160 | if (result != TCL_OK) { | |
161 | if (result == TCL_CONTINUE) { | |
162 | result = TCL_OK; | |
163 | } else if (result == TCL_BREAK) { | |
164 | result = TCL_OK; | |
165 | break; | |
166 | } else if (result == TCL_ERROR) { | |
167 | char buf [64]; | |
168 | ||
169 | sprintf (buf, "\n (\"loop\" body line %d)", | |
170 | interp->errorLine); | |
171 | Tcl_AddErrorInfo (interp, buf); | |
172 | break; | |
173 | } else { | |
174 | break; | |
175 | } | |
176 | } | |
177 | } | |
178 | /* | |
179 | * Set variable to its final value. | |
180 | */ | |
181 | sprintf (itxt,"%ld",i); | |
182 | if (Tcl_SetVar (interp, argv [1], itxt, TCL_LEAVE_ERR_MSG) == NULL) | |
183 | return TCL_ERROR; | |
184 | ||
185 | return result; | |
186 | } |