/[dtapublic]/projs/dtats/tags/0000.00/shared_source/c_tclxtens_7_5/credits.c
ViewVC logotype

Contents of /projs/dtats/tags/0000.00/shared_source/c_tclxtens_7_5/credits.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 98 - (show annotations) (download)
Sun Dec 18 00:57:31 2016 UTC (7 years, 11 months ago) by dashley
Original Path: projs/dtats/trunk/shared_source/c_tclxtens_7_5/credits.c
File MIME type: text/plain
File size: 11217 byte(s)
Reorganization.
1 //$Header$
2 //-------------------------------------------------------------------------------------------------
3 //This file is part of "David T. Ashley's Shared Source Code", a set of shared components
4 //integrated into many of David T. Ashley's projects.
5 //-------------------------------------------------------------------------------------------------
6 //This source code and any program in which it is compiled/used is provided under the MIT License,
7 //reproduced below.
8 //-------------------------------------------------------------------------------------------------
9 //Permission is hereby granted, free of charge, to any person obtaining a copy of
10 //this software and associated documentation files(the "Software"), to deal in the
11 //Software without restriction, including without limitation the rights to use,
12 //copy, modify, merge, publish, distribute, sublicense, and / or sell copies of the
13 //Software, and to permit persons to whom the Software is furnished to do so,
14 //subject to the following conditions :
15 //
16 //The above copyright notice and this permission notice shall be included in all
17 //copies or substantial portions of the Software.
18 //
19 //THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
20 //IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
21 //FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.IN NO EVENT SHALL THE
22 //AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
23 //LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
24 //OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
25 //SOFTWARE.
26 //-------------------------------------------------------------------------------------------------
27 #define MODULE_CREDITS
28
29 #include "tcl.h"
30 #include "tcldecls.h"
31
32 #include <string.h>
33
34 #include "build_config.h"
35 #include "credits.h"
36
37
38 //The array below is an array of string pointers which give information about who
39 //is responsible for what and so forth. Each atomic group (by atomic I mean the
40 //the minimum unit to be printed) is separated by a NULL pointer.
41 static char *credits_array[] =
42 {
43 "******************************************************************************",
44 "* This product is an open-source statically-linked version of Tcl/Tk 8.3.1, *",
45 "* originally from Scriptics. This product and its source code can be *",
46 "* downloaded at no cost from http://ijutools.sourceforge.net. We are *",
47 "* especially grateful to SourceForge for providing version control and *",
48 "* hosting services to the open-source community, and for technical support *",
49 "* on many occasions. Without SourceForge, this project would not have been *",
50 "* possible. This product is licensed under the GNU Public License (GPL). *",
51 "******************************************************************************",
52 NULL,
53 "Tcl/Tk 8.3.1",
54 " Interwoven (formerly Ajuba Solutions, formerly Scriptics), with special",
55 " thanks to Jeff Hobbs, Jan Nijtmans, Dave Graveaux, D. Richard Hipp (for",
56 " \"mktclapp\"), Dan Kuchler, John Ousterhout, and everyone at comp.lang.tcl.",
57 NULL,
58 "arbint",
59 " Implemented by Dave Ashley. Special thanks to the co-authors on the",
60 " original rational approximation paper (Joe DeVoe, Karl Perttunen, Cory",
61 " Pratt, and Anatoly Zhigljavsky). Special thanks to GNU for the GNU MP",
62 " library (GMP), which was used as a model to implement large integer",
63 " arithmetic.",
64 NULL,
65 "credits",
66 " Dave Ashley.",
67 NULL,
68 "crc32",
69 " Ideas for implementation and critical subroutines from Richard A.",
70 " Ellingson. Implemented by Dave Ashley.",
71 NULL,
72 "vcinfo",
73 " Dave Ashley.",
74 NULL,
75 "******************************************************************************",
76 NULL,
77 "David T. Ashley, DTASHLEY@AOL.COM, DAVEASHLEY@DAVEASHLEY.COM",
78 NULL,
79 "Joseph P. Devoe, JDEVOE@VISTEON.COM",
80 NULL,
81 "Richard A. Ellingson, RELLING@MAXINET.COM",
82 NULL,
83 "D. Richard Hipp, DRH@ACM.ORG",
84 NULL,
85 "Karl Perttunen, KPERTTUN@VISTEON.COM",
86 NULL,
87 "Cory Pratt, CORY_PRATT@3COM.COM",
88 NULL,
89 "Anatoly Zhigljavsky, ZHIGLJAVSKYAA@CARDIFF.AC.UK",
90 NULL,
91 "******************************************************************************",
92 };
93
94
95 //Crude function to convert character to upper case.
96 static char credits_to_upper(char arg)
97 {
98 if ((arg >= 'a') && (arg <= 'z'))
99 {
100 return(arg - ('a'-'A'));
101 }
102 else
103 {
104 return(arg);
105 }
106 }
107
108
109 //Comparison function used to determine if one string exists within
110 //another. The C++ library didn't have quite the function needed,
111 //so will write a crude and inefficient version. Will return true
112 //if contained, false otherwise.
113 //
114 static int credits_string_contained(const char *container, const char *containee)
115 {
116 size_t i, j, container_len, containee_len;
117 unsigned matches;
118
119 container_len = strlen(container);
120 containee_len = strlen(containee);
121
122 for (i=0; i<container_len; i++)
123 {
124 if ((container_len - i) < containee_len)
125 {
126 return 0;
127 //Not enough room to contain a match, no sense to check.
128 }
129
130 matches = 0;
131
132 for (j = 0; j < containee_len; j++)
133 {
134 if (credits_to_upper(container[i+j]) != credits_to_upper(containee[j]))
135 {
136 matches = 0;
137 break;
138 }
139 else
140 {
141 if (j==(containee_len - 1))
142 {
143 matches = 1;
144 break;
145 }
146 }
147 }
148
149 if (matches)
150 {
151 return 1;
152 }
153 }
154
155 return 0;
156 }
157
158
159 //Procedure called when the "credits" command is encountered in a Tcl script.
160 //
161 int CreditsCmd(ClientData dummy,
162 Tcl_Interp *interp,
163 int objc,
164 Tcl_Obj *objv[])
165 {
166 Tcl_Obj *rv;
167 //Value that will be returned.
168 unsigned idx, cur;
169 //Iteration variable.
170 unsigned something_found;
171 //Set TRUE if at least one match is located so that something from the
172 //credits array is displayed.
173 unsigned return_string_populated;
174 //TRUE if return string has something in it already.
175 unsigned mark_all_true;
176 //Set TRUE if should return everything.
177 unsigned display_this_group;
178 //Set TRUE if should display the group we are iterating through.
179 char *sptr;
180 //Pointer to the Tcl-build obj string representation.
181 //This belongs to Tcl and may not be modified.
182
183 /* Check to be sure if any arguments. If more than one argument,
184 ** should gen error.
185 */
186 if (objc > 2)
187 {
188 Tcl_WrongNumArgs(interp,
189 1,
190 objv,
191 "?searchstring?");
192
193 return TCL_ERROR;
194 }
195 else if ((objc == 1) || (objc == 2))
196 {
197 //If we have only one argument on the command-line, return everything,
198 //otherwise search.
199 mark_all_true = (objc == 1);
200
201 //Start off having found nothing.
202 something_found = 0;
203
204 //Return string is not yet populated.
205 return_string_populated = 0;
206
207 //Initialize the credits to an empty string. This will be added to.
208 rv = Tcl_NewStringObj("", -1);
209
210 //Loop through the list, either trying to match against
211 //the searchstring or adding unconditionally.
212 for (idx = 0; idx < (sizeof(credits_array)/sizeof(credits_array[0])); idx++)
213 {
214 //We just can't do a lot if we are resting on a NULL pointer.
215 if (credits_array[idx])
216 {
217 //We are resting on a pointer which is necessarily the start
218 //of an array of strings that should be displayed
219 //atomically. If we had that second argument on the
220 //command line, must search the array for a match.
221 if (mark_all_true)
222 {
223 display_this_group = 1;
224 something_found = 1;
225 }
226 else
227 {
228 //We need to work a bit harder to figure out whether to display
229 //this group of strings.
230 //
231 //Get the internal pointer.
232 sptr = Tcl_GetString(objv[1]);
233
234 //Loop through the embedded strings to see what to do. If find a
235 //match, can break immediately.
236 display_this_group = 0;
237 cur = idx;
238 while (credits_array[cur] && (cur < (sizeof(credits_array)/sizeof(credits_array[0]))))
239 {
240 if (credits_string_contained(credits_array[cur], sptr))
241 {
242 display_this_group = 1;
243 something_found = 1;
244 break;
245 }
246 cur++;
247 }
248 }
249
250
251 //We need to append a newline here if this ain't our first time
252 //tacking something into the return string.
253 if (display_this_group)
254 {
255 if (return_string_populated)
256 {
257 Tcl_AppendToObj(rv, "\n", -1);
258 }
259 else
260 {
261 return_string_populated = 1;
262 }
263 }
264
265
266 //Stage the material of interest in the return object. This also advances
267 //the array index.
268 while (credits_array[idx] && (idx < (sizeof(credits_array)/sizeof(credits_array[0]))))
269 {
270 if (display_this_group)
271 {
272 //Add the line of interest.
273 Tcl_AppendToObj(rv, credits_array[idx], -1);
274
275 //If not the very last string of the array or the last of a
276 //group, append newline.
277 if (idx != ((sizeof(credits_array)/sizeof(credits_array[0]))-1))
278 {
279 if (credits_array[idx+1])
280 {
281 Tcl_AppendToObj(rv, "\n", -1);
282 }
283 }
284 }
285
286 idx++;
287 }
288 }
289 }
290 }
291 else
292 {
293 //Should never get here. If do, no harm, as will do
294 //nothing and "credits" will not work--that is a bug
295 //that will definitely get looked at.
296 }
297
298 //Return the right result to the caller. If nothing was found, must say so.
299 if (!something_found)
300 {
301 Tcl_AppendToObj(rv, "No matches.", -1);
302 }
303 Tcl_SetObjResult(interp, rv);
304 return(TCL_OK);
305 }
306
307
308 //Performs initial registration to the hash table.
309 //
310 void CreditsInit(Tcl_Interp *interp)
311 {
312 //Register a command named "credits".
313 Tcl_CreateObjCommand(interp,
314 "credits",
315 (Tcl_ObjCmdProc *)CreditsCmd,
316 NULL,
317 NULL);
318 }
319
320
321 const char *CreditsCversion(void)
322 {
323 return ("$Header$");
324 }
325
326
327 const char *CreditsHversion(void)
328 {
329 return (CREDITS_H_VERSION);
330 }
331
332 /* End of credits.c */

Properties

Name Value
svn:eol-style native
svn:keywords Header

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25