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	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 */