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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

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

Legend:
Removed from v.68  
changed lines
  Added in v.71

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25