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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 71 - (hide annotations) (download)
Sat Nov 5 11:07:06 2016 UTC (8 years, 1 month ago) by dashley
Original Path: projs/trunk/shared_source/c_tclxtens_7_5/credits.c
File MIME type: text/plain
File size: 11217 byte(s)
Set EOL properties appropriately to facilitate simultaneous Linux and Windows development.
1 dashley 71 //$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