shared_source/c_tclxtens_7_5/credits.c

//$Header$
//-------------------------------------------------------------------------------------------------
//This file is part of "David T. Ashley's Shared Source Code", a set of shared components
//integrated into many of David T. Ashley's projects.
//-------------------------------------------------------------------------------------------------
//This source code and any program in which it is compiled/used is provided under the MIT License,
//reproduced below.
//-------------------------------------------------------------------------------------------------
//Permission is hereby granted, free of charge, to any person obtaining a copy of
//this software and associated documentation files(the "Software"), to deal in the
//Software without restriction, including without limitation the rights to use,
//copy, modify, merge, publish, distribute, sublicense, and / or sell copies of the
//Software, and to permit persons to whom the Software is furnished to do so,
//subject to the following conditions :
//
//The above copyright notice and this permission notice shall be included in all
//copies or substantial portions of the Software.
//
//THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
//IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
//FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.IN NO EVENT SHALL THE
//AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
//LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
//OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
//SOFTWARE.
//-------------------------------------------------------------------------------------------------
#define MODULE_CREDITS

#include "tcl.h"
#include "tcldecls.h"

#include <string.h>

#include "build_config.h"
#include "credits.h"


//The array below is an array of string pointers which give information about who
//is responsible for what and so forth.  Each atomic group (by atomic I mean the
//the minimum unit to be printed) is separated by a NULL pointer.
static char *credits_array[] =
   {
   "******************************************************************************",
   "* This product is an open-source statically-linked version of Tcl/Tk 8.3.1,  *",
   "* originally from Scriptics.  This product and its source code can be        *",
   "* downloaded at no cost from http://ijutools.sourceforge.net.  We are        *",
   "* especially grateful to SourceForge for providing version control and       *",
   "* hosting services to the open-source community, and for technical support   *",
   "* on many occasions.  Without SourceForge, this project would not have been  *",
   "* possible.  This product is licensed under the GNU Public License (GPL).    *",
   "******************************************************************************",
   NULL,
   "Tcl/Tk 8.3.1",
   "   Interwoven (formerly Ajuba Solutions, formerly Scriptics), with special",
   "   thanks to Jeff Hobbs, Jan Nijtmans, Dave Graveaux, D. Richard Hipp (for",
   "   \"mktclapp\"), Dan Kuchler, John Ousterhout, and everyone at comp.lang.tcl.",
   NULL,
   "arbint",
   "   Implemented by Dave Ashley.  Special thanks to the co-authors on the",
   "   original rational approximation paper (Joe DeVoe, Karl Perttunen, Cory",
   "   Pratt, and Anatoly Zhigljavsky).  Special thanks to GNU for the GNU MP",
   "   library (GMP), which was used as a model to implement large integer",
   "   arithmetic.",
   NULL,
   "credits",
   "   Dave Ashley.",
   NULL,
   "crc32",
   "   Ideas for implementation and critical subroutines from Richard A.",
   "   Ellingson.  Implemented by Dave Ashley.",
   NULL,
   "vcinfo",
   "   Dave Ashley.",
   NULL,
   "******************************************************************************",
   NULL,
   "David T. Ashley, DTASHLEY@AOL.COM, DAVEASHLEY@DAVEASHLEY.COM",
   NULL,
   "Joseph P. Devoe, JDEVOE@VISTEON.COM",
   NULL,
   "Richard A. Ellingson, RELLING@MAXINET.COM",
   NULL,
   "D. Richard Hipp, DRH@ACM.ORG",
   NULL,
   "Karl Perttunen, KPERTTUN@VISTEON.COM",
   NULL,
   "Cory Pratt, CORY_PRATT@3COM.COM",
   NULL,
   "Anatoly Zhigljavsky, ZHIGLJAVSKYAA@CARDIFF.AC.UK",
   NULL,
   "******************************************************************************",
   };


//Crude function to convert character to upper case.
static char credits_to_upper(char arg)
   {
   if ((arg >= 'a') && (arg <= 'z'))
      {
      return(arg - ('a'-'A'));
      }
   else
      {
      return(arg);
      }
   }


//Comparison function used to determine if one string exists within
//another.  The C++ library didn't have quite the function needed,
//so will write a crude and inefficient version.  Will return true
//if contained, false otherwise.
//
static int credits_string_contained(const char *container, const char *containee)
   {
   size_t   i, j, container_len, containee_len; 
   unsigned matches;

   container_len = strlen(container);
   containee_len = strlen(containee);

   for (i=0; i<container_len; i++)
      {
      if ((container_len - i) < containee_len)
         {
         return 0;
           //Not enough room to contain a match, no sense to check.
         }
      
      matches = 0;

      for (j = 0; j < containee_len; j++)
         {
         if (credits_to_upper(container[i+j]) != credits_to_upper(containee[j]))
            {
            matches = 0;
            break;
            }
         else
            {
            if (j==(containee_len - 1))
               {
               matches = 1;
               break;
               }
            }
         }

      if (matches)
         {
         return 1;
         }
      }

   return 0;
   }


//Procedure called when the "credits" command is encountered in a Tcl script.
//
int CreditsCmd(ClientData dummy, 
               Tcl_Interp *interp, 
               int objc,
               Tcl_Obj *objv[]) 
   {
 Tcl_Obj *rv;
      //Value that will be returned.
   unsigned idx, cur;
      //Iteration variable.
   unsigned something_found;
      //Set TRUE if at least one match is located so that something from the
      //credits array is displayed.
   unsigned return_string_populated;
      //TRUE if return string has something in it already.
   unsigned mark_all_true;
      //Set TRUE if should return everything.
   unsigned display_this_group;
      //Set TRUE if should display the group we are iterating through.
   char *sptr;
      //Pointer to the Tcl-build obj string representation.
      //This belongs to Tcl and may not be modified.

   /* Check to be sure if any arguments.  If more than one argument,
   ** should gen error.
   */
   if (objc > 2)
      {
      Tcl_WrongNumArgs(interp, 
                       1, 
                       objv, 
                       "?searchstring?");

      return TCL_ERROR;
      }
   else if ((objc == 1) || (objc == 2))
      {
      //If we have only one argument on the command-line, return everything,
      //otherwise search.
      mark_all_true = (objc == 1);

      //Start off having found nothing.
      something_found = 0;
      
      //Return string is not yet populated.
      return_string_populated = 0;

      //Initialize the credits to an empty string.  This will be added to.
      rv = Tcl_NewStringObj("", -1);

      //Loop through the list, either trying to match against
      //the searchstring or adding unconditionally.
      for (idx = 0; idx < (sizeof(credits_array)/sizeof(credits_array[0])); idx++)
         {
         //We just can't do a lot if we are resting on a NULL pointer.
         if (credits_array[idx])
            {
            //We are resting on a pointer which is necessarily the start
            //of an array of strings that should be displayed
            //atomically.  If we had that second argument on the
            //command line, must search the array for a match.
            if (mark_all_true)
               {
               display_this_group = 1;
               something_found = 1;
               }
            else
               {
               //We need to work a bit harder to figure out whether to display
               //this group of strings.
               //
               //Get the internal pointer.
               sptr = Tcl_GetString(objv[1]);

               //Loop through the embedded strings to see what to do.  If find a 
               //match, can break immediately.
               display_this_group = 0;
               cur = idx;
               while (credits_array[cur] && (cur < (sizeof(credits_array)/sizeof(credits_array[0]))))
                  {
                  if (credits_string_contained(credits_array[cur], sptr))
                     {
                     display_this_group = 1;
                     something_found = 1;
                     break;
                     }
                  cur++;
                  }
               }


            //We need to append a newline here if this ain't our first time
            //tacking something into the return string.
            if (display_this_group)
               {
               if (return_string_populated)
                  {
                  Tcl_AppendToObj(rv, "\n", -1);
                  }
               else
                  {
                  return_string_populated = 1;
                  }
               }


            //Stage the material of interest in the return object.  This also advances
            //the array index.
            while (credits_array[idx] && (idx < (sizeof(credits_array)/sizeof(credits_array[0]))))
               {
               if (display_this_group)
                  {
                  //Add the line of interest.
                  Tcl_AppendToObj(rv, credits_array[idx], -1);

                  //If not the very last string of the array or the last of a
                  //group, append newline.
                  if (idx != ((sizeof(credits_array)/sizeof(credits_array[0]))-1))
                     {
                     if (credits_array[idx+1])
                        {
                        Tcl_AppendToObj(rv, "\n", -1);
                        }
                     }
                  }

               idx++;
               }
            }
         }
      }
   else
      {
      //Should never get here.  If do, no harm, as will do
      //nothing and "credits" will not work--that is a bug
      //that will definitely get looked at.
      }

   //Return the right result to the caller.  If nothing was found, must say so.
   if (!something_found)
      {
      Tcl_AppendToObj(rv, "No matches.", -1);
      }
   Tcl_SetObjResult(interp, rv);
   return(TCL_OK);
   }


//Performs initial registration to the hash table.
//
void CreditsInit(Tcl_Interp *interp)
   {
   //Register a command named "credits".
   Tcl_CreateObjCommand(interp, 
                        "credits",
                        (Tcl_ObjCmdProc *)CreditsCmd,
                        NULL,
                        NULL);
   }


const char *CreditsCversion(void)
   {   
   return ("$Header$");
   }


const char *CreditsHversion(void)
   {   
   return (CREDITS_H_VERSION);
   }

/* End of credits.c */
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 */