source: trunk/kitgen/8.x/blt/generic/bltUtil.c

Last change on this file was 175, checked in by demin, 12 years ago

initial commit

File size: 38.6 KB
Line 
1/*
2 * bltUtil.c --
3 *
4 * This module implements utility procedures for the BLT
5 * toolkit.
6 *
7 * Copyright 1991-1998 Lucent Technologies, Inc.
8 *
9 * Permission to use, copy, modify, and distribute this software and
10 * its documentation for any purpose and without fee is hereby
11 * granted, provided that the above copyright notice appear in all
12 * copies and that both that the copyright notice and warranty
13 * disclaimer appear in supporting documentation, and that the names
14 * of Lucent Technologies any of their entities not be used in
15 * advertising or publicity pertaining to distribution of the software
16 * without specific, written prior permission.
17 *
18 * Lucent Technologies disclaims all warranties with regard to this
19 * software, including all implied warranties of merchantability and
20 * fitness. In no event shall Lucent Technologies be liable for any
21 * special, indirect or consequential damages or any damages
22 * whatsoever resulting from loss of use, data or profits, whether in
23 * an action of contract, negligence or other tortuous action, arising
24 * out of or in connection with the use or performance of this
25 * software.
26 */
27
28#include "bltInt.h"
29#if defined(__STDC__)
30#include <stdarg.h>
31#else
32#include <varargs.h>
33#endif
34#include "bltHash.h"
35
36#ifndef HAVE_STRTOLOWER
37void
38strtolower(s)
39 register char *s;
40{
41 while (*s != '\0') {
42 *s = tolower(UCHAR(*s));
43 s++;
44 }
45}
46#endif /* !HAVE_STRTOLOWER */
47
48#ifndef HAVE_STRCASECMP
49
50static unsigned char caseTable[] =
51{
52 (unsigned char)'\000', (unsigned char)'\001',
53 (unsigned char)'\002', (unsigned char)'\003',
54 (unsigned char)'\004', (unsigned char)'\005',
55 (unsigned char)'\006', (unsigned char)'\007',
56 (unsigned char)'\010', (unsigned char)'\011',
57 (unsigned char)'\012', (unsigned char)'\013',
58 (unsigned char)'\014', (unsigned char)'\015',
59 (unsigned char)'\016', (unsigned char)'\017',
60 (unsigned char)'\020', (unsigned char)'\021',
61 (unsigned char)'\022', (unsigned char)'\023',
62 (unsigned char)'\024', (unsigned char)'\025',
63 (unsigned char)'\026', (unsigned char)'\027',
64 (unsigned char)'\030', (unsigned char)'\031',
65 (unsigned char)'\032', (unsigned char)'\033',
66 (unsigned char)'\034', (unsigned char)'\035',
67 (unsigned char)'\036', (unsigned char)'\037',
68 (unsigned char)'\040', (unsigned char)'\041',
69 (unsigned char)'\042', (unsigned char)'\043',
70 (unsigned char)'\044', (unsigned char)'\045',
71 (unsigned char)'\046', (unsigned char)'\047',
72 (unsigned char)'\050', (unsigned char)'\051',
73 (unsigned char)'\052', (unsigned char)'\053',
74 (unsigned char)'\054', (unsigned char)'\055',
75 (unsigned char)'\056', (unsigned char)'\057',
76 (unsigned char)'\060', (unsigned char)'\061',
77 (unsigned char)'\062', (unsigned char)'\063',
78 (unsigned char)'\064', (unsigned char)'\065',
79 (unsigned char)'\066', (unsigned char)'\067',
80 (unsigned char)'\070', (unsigned char)'\071',
81 (unsigned char)'\072', (unsigned char)'\073',
82 (unsigned char)'\074', (unsigned char)'\075',
83 (unsigned char)'\076', (unsigned char)'\077',
84 (unsigned char)'\100', (unsigned char)'\141',
85 (unsigned char)'\142', (unsigned char)'\143',
86 (unsigned char)'\144', (unsigned char)'\145',
87 (unsigned char)'\146', (unsigned char)'\147',
88 (unsigned char)'\150', (unsigned char)'\151',
89 (unsigned char)'\152', (unsigned char)'\153',
90 (unsigned char)'\154', (unsigned char)'\155',
91 (unsigned char)'\156', (unsigned char)'\157',
92 (unsigned char)'\160', (unsigned char)'\161',
93 (unsigned char)'\162', (unsigned char)'\163',
94 (unsigned char)'\164', (unsigned char)'\165',
95 (unsigned char)'\166', (unsigned char)'\167',
96 (unsigned char)'\170', (unsigned char)'\171',
97 (unsigned char)'\172', (unsigned char)'\133',
98 (unsigned char)'\134', (unsigned char)'\135',
99 (unsigned char)'\136', (unsigned char)'\137',
100 (unsigned char)'\140', (unsigned char)'\141',
101 (unsigned char)'\142', (unsigned char)'\143',
102 (unsigned char)'\144', (unsigned char)'\145',
103 (unsigned char)'\146', (unsigned char)'\147',
104 (unsigned char)'\150', (unsigned char)'\151',
105 (unsigned char)'\152', (unsigned char)'\153',
106 (unsigned char)'\154', (unsigned char)'\155',
107 (unsigned char)'\156', (unsigned char)'\157',
108 (unsigned char)'\160', (unsigned char)'\161',
109 (unsigned char)'\162', (unsigned char)'\163',
110 (unsigned char)'\164', (unsigned char)'\165',
111 (unsigned char)'\166', (unsigned char)'\167',
112 (unsigned char)'\170', (unsigned char)'\171',
113 (unsigned char)'\172', (unsigned char)'\173',
114 (unsigned char)'\174', (unsigned char)'\175',
115 (unsigned char)'\176', (unsigned char)'\177',
116 (unsigned char)'\200', (unsigned char)'\201',
117 (unsigned char)'\202', (unsigned char)'\203',
118 (unsigned char)'\204', (unsigned char)'\205',
119 (unsigned char)'\206', (unsigned char)'\207',
120 (unsigned char)'\210', (unsigned char)'\211',
121 (unsigned char)'\212', (unsigned char)'\213',
122 (unsigned char)'\214', (unsigned char)'\215',
123 (unsigned char)'\216', (unsigned char)'\217',
124 (unsigned char)'\220', (unsigned char)'\221',
125 (unsigned char)'\222', (unsigned char)'\223',
126 (unsigned char)'\224', (unsigned char)'\225',
127 (unsigned char)'\226', (unsigned char)'\227',
128 (unsigned char)'\230', (unsigned char)'\231',
129 (unsigned char)'\232', (unsigned char)'\233',
130 (unsigned char)'\234', (unsigned char)'\235',
131 (unsigned char)'\236', (unsigned char)'\237',
132 (unsigned char)'\240', (unsigned char)'\241',
133 (unsigned char)'\242', (unsigned char)'\243',
134 (unsigned char)'\244', (unsigned char)'\245',
135 (unsigned char)'\246', (unsigned char)'\247',
136 (unsigned char)'\250', (unsigned char)'\251',
137 (unsigned char)'\252', (unsigned char)'\253',
138 (unsigned char)'\254', (unsigned char)'\255',
139 (unsigned char)'\256', (unsigned char)'\257',
140 (unsigned char)'\260', (unsigned char)'\261',
141 (unsigned char)'\262', (unsigned char)'\263',
142 (unsigned char)'\264', (unsigned char)'\265',
143 (unsigned char)'\266', (unsigned char)'\267',
144 (unsigned char)'\270', (unsigned char)'\271',
145 (unsigned char)'\272', (unsigned char)'\273',
146 (unsigned char)'\274', (unsigned char)'\275',
147 (unsigned char)'\276', (unsigned char)'\277',
148 (unsigned char)'\300', (unsigned char)'\341',
149 (unsigned char)'\342', (unsigned char)'\343',
150 (unsigned char)'\344', (unsigned char)'\345',
151 (unsigned char)'\346', (unsigned char)'\347',
152 (unsigned char)'\350', (unsigned char)'\351',
153 (unsigned char)'\352', (unsigned char)'\353',
154 (unsigned char)'\354', (unsigned char)'\355',
155 (unsigned char)'\356', (unsigned char)'\357',
156 (unsigned char)'\360', (unsigned char)'\361',
157 (unsigned char)'\362', (unsigned char)'\363',
158 (unsigned char)'\364', (unsigned char)'\365',
159 (unsigned char)'\366', (unsigned char)'\367',
160 (unsigned char)'\370', (unsigned char)'\371',
161 (unsigned char)'\372', (unsigned char)'\333',
162 (unsigned char)'\334', (unsigned char)'\335',
163 (unsigned char)'\336', (unsigned char)'\337',
164 (unsigned char)'\340', (unsigned char)'\341',
165 (unsigned char)'\342', (unsigned char)'\343',
166 (unsigned char)'\344', (unsigned char)'\345',
167 (unsigned char)'\346', (unsigned char)'\347',
168 (unsigned char)'\350', (unsigned char)'\351',
169 (unsigned char)'\352', (unsigned char)'\353',
170 (unsigned char)'\354', (unsigned char)'\355',
171 (unsigned char)'\356', (unsigned char)'\357',
172 (unsigned char)'\360', (unsigned char)'\361',
173 (unsigned char)'\362', (unsigned char)'\363',
174 (unsigned char)'\364', (unsigned char)'\365',
175 (unsigned char)'\366', (unsigned char)'\367',
176 (unsigned char)'\370', (unsigned char)'\371',
177 (unsigned char)'\372', (unsigned char)'\373',
178 (unsigned char)'\374', (unsigned char)'\375',
179 (unsigned char)'\376', (unsigned char)'\377',
180};
181
182/*
183 *----------------------------------------------------------------------
184 *
185 * strcasecmp --
186 *
187 * Compare two strings, disregarding case.
188 *
189 * Results:
190 * Returns a signed integer representing the following:
191 *
192 * zero - two strings are equal
193 * negative - first string is less than second
194 * positive - first string is greater than second
195 *
196 *----------------------------------------------------------------------
197 */
198int
199strcasecmp(s1, s2)
200 CONST char *s1;
201 CONST char *s2;
202{
203 unsigned char *s = (unsigned char *)s1;
204 unsigned char *t = (unsigned char *)s2;
205
206 for ( /* empty */ ; (caseTable[*s] == caseTable[*t]); s++, t++) {
207 if (*s == '\0') {
208 return 0;
209 }
210 }
211 return (caseTable[*s] - caseTable[*t]);
212}
213
214/*
215 *----------------------------------------------------------------------
216 *
217 * strncasecmp --
218 *
219 * Compare two strings, disregarding case, up to a given length.
220 *
221 * Results:
222 * Returns a signed integer representing the following:
223 *
224 * zero - two strings are equal
225 * negative - first string is less than second
226 * positive - first string is greater than second
227 *
228 *----------------------------------------------------------------------
229 */
230int
231strncasecmp(s1, s2, length)
232 CONST char *s1;
233 CONST char *s2;
234 size_t length;
235{
236 register unsigned char *s = (unsigned char *)s1;
237 register unsigned char *t = (unsigned char *)s2;
238
239 for ( /* empty */ ; (length > 0); s++, t++, length--) {
240 if (caseTable[*s] != caseTable[*t]) {
241 return (caseTable[*s] - caseTable[*t]);
242 }
243 if (*s == '\0') {
244 return 0;
245 }
246 }
247 return 0;
248}
249
250#endif /* !HAVE_STRCASECMP */
251
252
253#if (TCL_VERSION_NUMBER < _VERSION(8,1,0)) && (TCL_MAJOR_VERSION > 7)
254
255char *
256Tcl_GetString(Tcl_Obj *objPtr)
257{
258 unsigned int dummy;
259
260 return Tcl_GetStringFromObj(objPtr, &dummy);
261}
262
263int
264Tcl_EvalObjv(Tcl_Interp *interp, int objc, Tcl_Obj **objv, int flags)
265{
266 Tcl_DString dString;
267 register int i;
268 int result;
269
270 Tcl_DStringInit(&dString);
271 for (i = 0; i < objc; i++) {
272 Tcl_DStringAppendElement(&dString, Tcl_GetString(objv[i]));
273 }
274 result = Tcl_Eval(interp, Tcl_DStringValue(&dString));
275 Tcl_DStringFree(&dString);
276 return result;
277}
278
279int
280Tcl_WriteObj(Tcl_Channel channel, Tcl_Obj *objPtr)
281{
282 char *data;
283 int nBytes;
284
285 data = Tcl_GetStringFromObj(objPtr, &nBytes);
286 return Tcl_Write(channel, data, nBytes);
287}
288
289char *
290Tcl_SetVar2Ex(
291 Tcl_Interp *interp,
292 char *part1,
293 char *part2,
294 Tcl_Obj *objPtr,
295 int flags)
296{
297 return Tcl_SetVar2(interp, part1, part2, Tcl_GetString(objPtr), flags);
298}
299
300Tcl_Obj *
301Tcl_GetVar2Ex(
302 Tcl_Interp *interp,
303 char *part1,
304 char *part2,
305 int flags)
306{
307 char *result;
308
309 result = Tcl_GetVar2(interp, part1, part2, flags);
310 if (result == NULL) {
311 return NULL;
312 }
313 return Tcl_NewStringObj(result, -1);
314}
315
316#endif
317
318/*
319 *----------------------------------------------------------------------
320 *
321 * CompareByDictionary
322 *
323 * This function compares two strings as if they were being used in
324 * an index or card catalog. The case of alphabetic characters is
325 * ignored, except to break ties. Thus "B" comes before "b" but
326 * after "a". Also, integers embedded in the strings compare in
327 * numerical order. In other words, "x10y" comes after "x9y", not
328 * before it as it would when using strcmp().
329 *
330 * Results:
331 * A negative result means that the first element comes before the
332 * second, and a positive result means that the second element
333 * should come first. A result of zero means the two elements
334 * are equal and it doesn't matter which comes first.
335 *
336 * Side effects:
337 * None.
338 *
339 *----------------------------------------------------------------------
340 */
341
342#if HAVE_UTF
343int
344Blt_DictionaryCompare(left, right)
345 char *left, *right;
346{
347 Tcl_UniChar uniLeft, uniRight, uniLeftLower, uniRightLower;
348 int diff, zeros;
349 int secondaryDiff = 0;
350
351 for(;;) {
352 if ((isdigit(UCHAR(*right))) && (isdigit(UCHAR(*left)))) {
353 /*
354 * There are decimal numbers embedded in the two
355 * strings. Compare them as numbers, rather than
356 * strings. If one number has more leading zeros than
357 * the other, the number with more leading zeros sorts
358 * later, but only as a secondary choice.
359 */
360
361 zeros = 0;
362 while ((*right == '0') && (isdigit(UCHAR(right[1])))) {
363 right++;
364 zeros--;
365 }
366 while ((*left == '0') && (isdigit(UCHAR(left[1])))) {
367 left++;
368 zeros++;
369 }
370 if (secondaryDiff == 0) {
371 secondaryDiff = zeros;
372 }
373
374 /*
375 * The code below compares the numbers in the two
376 * strings without ever converting them to integers. It
377 * does this by first comparing the lengths of the
378 * numbers and then comparing the digit values.
379 */
380
381 diff = 0;
382 for (;;) {
383 if (diff == 0) {
384 diff = UCHAR(*left) - UCHAR(*right);
385 }
386 right++;
387 left++;
388
389 /* Ignore commas in numbers. */
390 if (*left == ',') {
391 left++;
392 }
393 if (*right == ',') {
394 right++;
395 }
396
397 if (!isdigit(UCHAR(*right))) { /* INTL: digit */
398 if (isdigit(UCHAR(*left))) { /* INTL: digit */
399 return 1;
400 } else {
401 /*
402 * The two numbers have the same length. See
403 * if their values are different.
404 */
405
406 if (diff != 0) {
407 return diff;
408 }
409 break;
410 }
411 } else if (!isdigit(UCHAR(*left))) { /* INTL: digit */
412 return -1;
413 }
414 }
415 continue;
416 }
417
418 /*
419 * Convert character to Unicode for comparison purposes. If either
420 * string is at the terminating null, do a byte-wise comparison and
421 * bail out immediately.
422 */
423 if ((*left != '\0') && (*right != '\0')) {
424 left += Tcl_UtfToUniChar(left, &uniLeft);
425 right += Tcl_UtfToUniChar(right, &uniRight);
426 /*
427 * Convert both chars to lower for the comparison, because
428 * dictionary sorts are case insensitve. Convert to lower, not
429 * upper, so chars between Z and a will sort before A (where most
430 * other interesting punctuations occur)
431 */
432 uniLeftLower = Tcl_UniCharToLower(uniLeft);
433 uniRightLower = Tcl_UniCharToLower(uniRight);
434 } else {
435 diff = UCHAR(*left) - UCHAR(*right);
436 break;
437 }
438
439 diff = uniLeftLower - uniRightLower;
440 if (diff) {
441 return diff;
442 } else if (secondaryDiff == 0) {
443 if (Tcl_UniCharIsUpper(uniLeft) &&
444 Tcl_UniCharIsLower(uniRight)) {
445 secondaryDiff = -1;
446 } else if (Tcl_UniCharIsUpper(uniRight)
447 && Tcl_UniCharIsLower(uniLeft)) {
448 secondaryDiff = 1;
449 }
450 }
451 }
452 if (diff == 0) {
453 diff = secondaryDiff;
454 }
455 return diff;
456}
457
458#else
459
460int
461Blt_DictionaryCompare(left, right)
462 char *left, *right; /* The strings to compare */
463{
464 int diff, zeros;
465 int secondaryDiff = 0;
466
467 while (1) {
468 if (isdigit(UCHAR(*right)) && isdigit(UCHAR(*left))) {
469 /*
470 * There are decimal numbers embedded in the two
471 * strings. Compare them as numbers, rather than
472 * strings. If one number has more leading zeros than
473 * the other, the number with more leading zeros sorts
474 * later, but only as a secondary choice.
475 */
476
477 zeros = 0;
478 while ((*right == '0') && (isdigit(UCHAR(right[1])))) {
479 right++;
480 zeros--;
481 }
482 while ((*left == '0') && (isdigit(UCHAR(left[1])))) {
483 left++;
484 zeros++;
485 }
486 if (secondaryDiff == 0) {
487 secondaryDiff = zeros;
488 }
489
490 /*
491 * The code below compares the numbers in the two
492 * strings without ever converting them to integers. It
493 * does this by first comparing the lengths of the
494 * numbers and then comparing the digit values.
495 */
496
497 diff = 0;
498 while (1) {
499 if (diff == 0) {
500 diff = UCHAR(*left) - UCHAR(*right);
501 }
502 right++;
503 left++;
504 /* Ignore commas in numbers. */
505 if (*left == ',') {
506 left++;
507 }
508 if (*right == ',') {
509 right++;
510 }
511 if (!isdigit(UCHAR(*right))) {
512 if (isdigit(UCHAR(*left))) {
513 return 1;
514 } else {
515 /*
516 * The two numbers have the same length. See
517 * if their values are different.
518 */
519
520 if (diff != 0) {
521 return diff;
522 }
523 break;
524 }
525 } else if (!isdigit(UCHAR(*left))) {
526 return -1;
527 }
528 }
529 continue;
530 }
531 diff = UCHAR(*left) - UCHAR(*right);
532 if (diff) {
533 if (isupper(UCHAR(*left)) && islower(UCHAR(*right))) {
534 diff = UCHAR(tolower(*left)) - UCHAR(*right);
535 if (diff) {
536 return diff;
537 } else if (secondaryDiff == 0) {
538 secondaryDiff = -1;
539 }
540 } else if (isupper(UCHAR(*right)) && islower(UCHAR(*left))) {
541 diff = UCHAR(*left) - UCHAR(tolower(UCHAR(*right)));
542 if (diff) {
543 return diff;
544 } else if (secondaryDiff == 0) {
545 secondaryDiff = 1;
546 }
547 } else {
548 return diff;
549 }
550 }
551 if (*left == 0) {
552 break;
553 }
554 left++;
555 right++;
556 }
557 if (diff == 0) {
558 diff = secondaryDiff;
559 }
560 return diff;
561}
562#endif
563
564#ifndef NDEBUG
565void
566Blt_Assert(testExpr, fileName, lineNumber)
567 char *testExpr;
568 char *fileName;
569 int lineNumber;
570{
571#ifdef WINDEBUG
572 PurifyPrintf("line %d of %s: Assert \"%s\" failed\n", lineNumber,
573 fileName, testExpr);
574#endif
575 fprintf(stderr, "line %d of %s: Assert \"%s\" failed\n",
576 lineNumber, fileName, testExpr);
577 fflush(stderr);
578 abort();
579}
580#endif
581
582/*ARGSUSED*/
583void
584Blt_Panic TCL_VARARGS_DEF(char *, arg1)
585{
586 va_list argList;
587 char *format;
588
589 format = TCL_VARARGS_START(char *, arg1, argList);
590 vfprintf(stderr, format, argList);
591 fprintf(stderr, "\n");
592 fflush(stderr);
593 abort();
594}
595
596void
597Blt_DStringAppendElements
598TCL_VARARGS_DEF(Tcl_DString *, arg1)
599{
600 va_list argList;
601 Tcl_DString *dsPtr;
602 register char *elem;
603
604 dsPtr = TCL_VARARGS_START(Tcl_DString *, arg1, argList);
605 while ((elem = va_arg(argList, char *)) != NULL) {
606 Tcl_DStringAppendElement(dsPtr, elem);
607 }
608 va_end(argList);
609}
610
611static char stringRep[200];
612
613char *
614Blt_Itoa(value)
615 int value;
616{
617 sprintf(stringRep, "%d", value);
618 return stringRep;
619}
620
621char *
622Blt_Utoa(value)
623 unsigned int value;
624{
625 sprintf(stringRep, "%u", value);
626 return stringRep;
627}
628
629char *
630Blt_Dtoa(interp, value)
631 Tcl_Interp *interp;
632 double value;
633{
634 Tcl_PrintDouble(interp, value, stringRep);
635 return stringRep;
636}
637
638#if HAVE_UTF
639
640#undef fopen
641FILE *
642Blt_OpenUtfFile(fileName, mode)
643 char *fileName, *mode;
644{
645 Tcl_DString dString;
646 FILE *f;
647
648 fileName = Tcl_UtfToExternalDString(NULL, fileName, -1, &dString);
649 f = fopen(fileName, mode);
650 Tcl_DStringFree(&dString);
651 return f;
652}
653
654#endif /* HAVE_UTF */
655
656/*
657 *--------------------------------------------------------------
658 *
659 * Blt_InitHexTable --
660 *
661 * Table index for the hex values. Initialized once, first time.
662 * Used for translation value or delimiter significance lookup.
663 *
664 * We build the table at run time for several reasons:
665 *
666 * 1. portable to non-ASCII machines.
667 * 2. still reentrant since we set the init flag after setting
668 * table.
669 * 3. easier to extend.
670 * 4. less prone to bugs.
671 *
672 * Results:
673 * None.
674 *
675 *--------------------------------------------------------------
676 */
677void
678Blt_InitHexTable(hexTable)
679 char hexTable[];
680{
681 hexTable['0'] = 0;
682 hexTable['1'] = 1;
683 hexTable['2'] = 2;
684 hexTable['3'] = 3;
685 hexTable['4'] = 4;
686 hexTable['5'] = 5;
687 hexTable['6'] = 6;
688 hexTable['7'] = 7;
689 hexTable['8'] = 8;
690 hexTable['9'] = 9;
691 hexTable['a'] = hexTable['A'] = 10;
692 hexTable['b'] = hexTable['B'] = 11;
693 hexTable['c'] = hexTable['C'] = 12;
694 hexTable['d'] = hexTable['D'] = 13;
695 hexTable['e'] = hexTable['E'] = 14;
696 hexTable['f'] = hexTable['F'] = 15;
697}
698
699/*
700 *--------------------------------------------------------------
701 *
702 * Blt_GetPosition --
703 *
704 * Convert a string representing a numeric position.
705 * A position can be in one of the following forms.
706 *
707 * number - number of the item in the hierarchy, indexed
708 * from zero.
709 * "end" - last position in the hierarchy.
710 *
711 * Results:
712 * A standard Tcl result. If "string" is a valid index, then
713 * *indexPtr is filled with the corresponding numeric index.
714 * If "end" was selected then *indexPtr is set to -1.
715 * Otherwise an error message is left in interp->result.
716 *
717 * Side effects:
718 * None.
719 *
720 *--------------------------------------------------------------
721 */
722int
723Blt_GetPosition(interp, string, indexPtr)
724 Tcl_Interp *interp; /* Interpreter to report results back
725 * to. */
726 char *string; /* String representation of the index.
727 * Can be an integer or "end" to refer
728 * to the last index. */
729 int *indexPtr; /* Holds the converted index. */
730{
731 if ((string[0] == 'e') && (strcmp(string, "end") == 0)) {
732 *indexPtr = -1; /* Indicates last position in hierarchy. */
733 } else {
734 int position;
735
736 if (Tcl_GetInt(interp, string, &position) != TCL_OK) {
737 return TCL_ERROR;
738 }
739 if (position < 0) {
740 Tcl_AppendResult(interp, "bad position \"", string, "\"",
741 (char *)NULL);
742 return TCL_ERROR;
743 }
744 *indexPtr = position;
745 }
746 return TCL_OK;
747}
748
749/*
750 * The hash table below is used to keep track of all the Blt_Uids created
751 * so far.
752 */
753static Blt_HashTable uidTable;
754static int uidInitialized = 0;
755
756/*
757 *----------------------------------------------------------------------
758 *
759 * Blt_GetUid --
760 *
761 * Given a string, returns a unique identifier for the string.
762 * A reference count is maintained, so that the identifier
763 * can be freed when it is not needed any more. This can be used
764 * in many places to replace Tcl_GetUid.
765 *
766 * Results:
767 * This procedure returns a Blt_Uid corresponding to the "string"
768 * argument. The Blt_Uid has a string value identical to string
769 * (strcmp will return 0), but it's guaranteed that any other
770 * calls to this procedure with a string equal to "string" will
771 * return exactly the same result (i.e. can compare Blt_Uid
772 * *values* directly, without having to call strcmp on what they
773 * point to).
774 *
775 * Side effects:
776 * New information may be entered into the identifier table.
777 *
778 *----------------------------------------------------------------------
779 */
780Blt_Uid
781Blt_GetUid(string)
782 char *string; /* String to convert. */
783{
784 int isNew;
785 Blt_HashEntry *hPtr;
786 int refCount;
787
788 if (!uidInitialized) {
789 Blt_InitHashTable(&uidTable, BLT_STRING_KEYS);
790 uidInitialized = 1;
791 }
792 hPtr = Blt_CreateHashEntry(&uidTable, string, &isNew);
793 if (isNew) {
794 refCount = 0;
795 } else {
796 refCount = (int)Blt_GetHashValue(hPtr);
797 }
798 refCount++;
799 Blt_SetHashValue(hPtr, (ClientData)refCount);
800 return (Blt_Uid)Blt_GetHashKey(&uidTable, hPtr);
801}
802
803/*
804 *----------------------------------------------------------------------
805 *
806 * Blt_FreeUid --
807 *
808 * Frees the Blt_Uid if there are no more clients using this
809 * identifier.
810 *
811 * Results:
812 * None.
813 *
814 * Side effects:
815 * The identifier may be deleted from the identifier table.
816 *
817 *----------------------------------------------------------------------
818 */
819void
820Blt_FreeUid(uid)
821 Blt_Uid uid; /* Identifier to release. */
822{
823 Blt_HashEntry *hPtr;
824
825 if (!uidInitialized) {
826 Blt_InitHashTable(&uidTable, BLT_STRING_KEYS);
827 uidInitialized = 1;
828 }
829 hPtr = Blt_FindHashEntry(&uidTable, uid);
830 if (hPtr) {
831 int refCount;
832
833 refCount = (int)Blt_GetHashValue(hPtr);
834 refCount--;
835 if (refCount == 0) {
836 Blt_DeleteHashEntry(&uidTable, hPtr);
837 } else {
838 Blt_SetHashValue(hPtr, (ClientData)refCount);
839 }
840 } else {
841 fprintf(stderr, "tried to release unknown identifier \"%s\"\n", uid);
842 }
843}
844
845/*
846 *----------------------------------------------------------------------
847 *
848 * Blt_FindUid --
849 *
850 * Returns a Blt_Uid associated with a given string, if one exists.
851 *
852 * Results:
853 * A Blt_Uid for the string if one exists. Otherwise NULL.
854 *
855 *----------------------------------------------------------------------
856 */
857Blt_Uid
858Blt_FindUid(string)
859 char *string; /* String to find. */
860{
861 Blt_HashEntry *hPtr;
862
863 if (!uidInitialized) {
864 Blt_InitHashTable(&uidTable, BLT_STRING_KEYS);
865 uidInitialized = 1;
866 }
867 hPtr = Blt_FindHashEntry(&uidTable, string);
868 if (hPtr == NULL) {
869 return NULL;
870 }
871 return (Blt_Uid) Blt_GetHashKey(&uidTable, hPtr);
872}
873
874/*
875 *----------------------------------------------------------------------
876 *
877 * BinaryOpSearch --
878 *
879 * Performs a binary search on the array of command operation
880 * specifications to find a partial, anchored match for the
881 * given operation string.
882 *
883 * Results:
884 * If the string matches unambiguously the index of the specification
885 * in the array is returned. If the string does not match, even
886 * as an abbreviation, any operation, -1 is returned. If the string
887 * matches, but ambiguously -2 is returned.
888 *
889 *----------------------------------------------------------------------
890 */
891static int
892BinaryOpSearch(specArr, nSpecs, string)
893 Blt_OpSpec specArr[];
894 int nSpecs;
895 char *string; /* Name of minor operation to search for */
896{
897 Blt_OpSpec *specPtr;
898 char c;
899 register int high, low, median;
900 register int compare, length;
901
902 low = 0;
903 high = nSpecs - 1;
904 c = string[0];
905 length = strlen(string);
906 while (low <= high) {
907 median = (low + high) >> 1;
908 specPtr = specArr + median;
909
910 /* Test the first character */
911 compare = c - specPtr->name[0];
912 if (compare == 0) {
913 /* Now test the entire string */
914 compare = strncmp(string, specPtr->name, length);
915 if (compare == 0) {
916 if (length < specPtr->minChars) {
917 return -2; /* Ambiguous operation name */
918 }
919 }
920 }
921 if (compare < 0) {
922 high = median - 1;
923 } else if (compare > 0) {
924 low = median + 1;
925 } else {
926 return median; /* Op found. */
927 }
928 }
929 return -1; /* Can't find operation */
930}
931
932
933/*
934 *----------------------------------------------------------------------
935 *
936 * LinearOpSearch --
937 *
938 * Performs a binary search on the array of command operation
939 * specifications to find a partial, anchored match for the
940 * given operation string.
941 *
942 * Results:
943 * If the string matches unambiguously the index of the specification
944 * in the array is returned. If the string does not match, even
945 * as an abbreviation, any operation, -1 is returned. If the string
946 * matches, but ambiguously -2 is returned.
947 *
948 *----------------------------------------------------------------------
949 */
950static int
951LinearOpSearch(specArr, nSpecs, string)
952 Blt_OpSpec specArr[];
953 int nSpecs;
954 char *string; /* Name of minor operation to search for */
955{
956 Blt_OpSpec *specPtr;
957 char c;
958 int length, nMatches, last;
959 register int i;
960
961 c = string[0];
962 length = strlen(string);
963 nMatches = 0;
964 last = -1;
965 for (specPtr = specArr, i = 0; i < nSpecs; i++, specPtr++) {
966 if ((c == specPtr->name[0]) &&
967 (strncmp(string, specPtr->name, length) == 0)) {
968 last = i;
969 nMatches++;
970 if (length == specPtr->minChars) {
971 break;
972 }
973 }
974 }
975 if (nMatches > 1) {
976 return -2; /* Ambiguous operation name */
977 }
978 if (nMatches == 0) {
979 return -1; /* Can't find operation */
980 }
981 return last; /* Op found. */
982}
983
984/*
985 *----------------------------------------------------------------------
986 *
987 * Blt_GetOp --
988 *
989 * Find the command operation given a string name. This is useful
990 * where a group of command operations have the same argument
991 * signature.
992 *
993 * Results:
994 * If found, a pointer to the procedure (function pointer) is
995 * returned. Otherwise NULL is returned and an error message
996 * containing a list of the possible commands is returned in
997 * interp->result.
998 *
999 *----------------------------------------------------------------------
1000 */
1001Blt_Op
1002Blt_GetOp(interp, nSpecs, specArr, operPos, argc, argv, flags)
1003 Tcl_Interp *interp; /* Interpreter to report errors to */
1004 int nSpecs; /* Number of specifications in array */
1005 Blt_OpSpec specArr[]; /* Op specification array */
1006 int operPos; /* Index of the operation name argument */
1007 int argc; /* Number of arguments in the argument vector.
1008 * This includes any prefixed arguments */
1009 char *argv[]; /* Argument vector */
1010 int flags; /* */
1011{
1012 Blt_OpSpec *specPtr;
1013 char *string;
1014 register int i;
1015 register int n;
1016
1017 if (argc <= operPos) { /* No operation argument */
1018 Tcl_AppendResult(interp, "wrong # args: ", (char *)NULL);
1019 usage:
1020 Tcl_AppendResult(interp, "should be one of...", (char *)NULL);
1021 for (n = 0; n < nSpecs; n++) {
1022 Tcl_AppendResult(interp, "\n ", (char *)NULL);
1023 for (i = 0; i < operPos; i++) {
1024 Tcl_AppendResult(interp, argv[i], " ", (char *)NULL);
1025 }
1026 specPtr = specArr + n;
1027 Tcl_AppendResult(interp, specPtr->name, " ", specPtr->usage,
1028 (char *)NULL);
1029 }
1030 return NULL;
1031 }
1032 string = argv[operPos];
1033 if (flags & BLT_OP_LINEAR_SEARCH) {
1034 n = LinearOpSearch(specArr, nSpecs, string);
1035 } else {
1036 n = BinaryOpSearch(specArr, nSpecs, string);
1037 }
1038 if (n == -2) {
1039 char c;
1040 int length;
1041
1042 Tcl_AppendResult(interp, "ambiguous", (char *)NULL);
1043 if (operPos > 2) {
1044 Tcl_AppendResult(interp, " ", argv[operPos - 1], (char *)NULL);
1045 }
1046 Tcl_AppendResult(interp, " operation \"", string, "\" matches:",
1047 (char *)NULL);
1048
1049 c = string[0];
1050 length = strlen(string);
1051 for (n = 0; n < nSpecs; n++) {
1052 specPtr = specArr + n;
1053 if ((c == specPtr->name[0]) &&
1054 (strncmp(string, specPtr->name, length) == 0)) {
1055 Tcl_AppendResult(interp, " ", specPtr->name, (char *)NULL);
1056 }
1057 }
1058 return NULL;
1059
1060 } else if (n == -1) { /* Can't find operation, display help */
1061 Tcl_AppendResult(interp, "bad", (char *)NULL);
1062 if (operPos > 2) {
1063 Tcl_AppendResult(interp, " ", argv[operPos - 1], (char *)NULL);
1064 }
1065 Tcl_AppendResult(interp, " operation \"", string, "\": ",
1066 (char *)NULL);
1067 goto usage;
1068 }
1069 specPtr = specArr + n;
1070 if ((argc < specPtr->minArgs) || ((specPtr->maxArgs > 0) &&
1071 (argc > specPtr->maxArgs))) {
1072 Tcl_AppendResult(interp, "wrong # args: should be \"", (char *)NULL);
1073 for (i = 0; i < operPos; i++) {
1074 Tcl_AppendResult(interp, argv[i], " ", (char *)NULL);
1075 }
1076 Tcl_AppendResult(interp, specPtr->name, " ", specPtr->usage, "\"",
1077 (char *)NULL);
1078 return NULL;
1079 }
1080 return specPtr->proc;
1081}
1082
1083#if (TCL_VERSION_NUMBER >= _VERSION(8,0,0))
1084
1085/*
1086 *----------------------------------------------------------------------
1087 *
1088 * Blt_GetOpFromObj --
1089 *
1090 * Find the command operation given a string name. This is useful
1091 * where a group of command operations have the same argument
1092 * signature.
1093 *
1094 * Results:
1095 * If found, a pointer to the procedure (function pointer) is
1096 * returned. Otherwise NULL is returned and an error message
1097 * containing a list of the possible commands is returned in
1098 * interp->result.
1099 *
1100 *----------------------------------------------------------------------
1101 */
1102Blt_Op
1103Blt_GetOpFromObj(interp, nSpecs, specArr, operPos, objc, objv, flags)
1104 Tcl_Interp *interp; /* Interpreter to report errors to */
1105 int nSpecs; /* Number of specifications in array */
1106 Blt_OpSpec specArr[]; /* Op specification array */
1107 int operPos; /* Position of operation in argument list. */
1108 int objc; /* Number of arguments in the argument vector.
1109 * This includes any prefixed arguments */
1110 Tcl_Obj *CONST objv[]; /* Argument vector */
1111 int flags;
1112{
1113 Blt_OpSpec *specPtr;
1114 char *string;
1115 register int i;
1116 register int n;
1117
1118 if (objc <= operPos) { /* No operation argument */
1119 Tcl_AppendResult(interp, "wrong # args: ", (char *)NULL);
1120 usage:
1121 Tcl_AppendResult(interp, "should be one of...", (char *)NULL);
1122 for (n = 0; n < nSpecs; n++) {
1123 Tcl_AppendResult(interp, "\n ", (char *)NULL);
1124 for (i = 0; i < operPos; i++) {
1125 Tcl_AppendResult(interp, Tcl_GetString(objv[i]), " ",
1126 (char *)NULL);
1127 }
1128 specPtr = specArr + n;
1129 Tcl_AppendResult(interp, specPtr->name, " ", specPtr->usage,
1130 (char *)NULL);
1131 }
1132 return NULL;
1133 }
1134 string = Tcl_GetString(objv[operPos]);
1135 if (flags & BLT_OP_LINEAR_SEARCH) {
1136 n = LinearOpSearch(specArr, nSpecs, string);
1137 } else {
1138 n = BinaryOpSearch(specArr, nSpecs, string);
1139 }
1140 if (n == -2) {
1141 char c;
1142 int length;
1143
1144 Tcl_AppendResult(interp, "ambiguous", (char *)NULL);
1145 if (operPos > 2) {
1146 Tcl_AppendResult(interp, " ", Tcl_GetString(objv[operPos - 1]),
1147 (char *)NULL);
1148 }
1149 Tcl_AppendResult(interp, " operation \"", string, "\" matches:",
1150 (char *)NULL);
1151
1152 c = string[0];
1153 length = strlen(string);
1154 for (n = 0; n < nSpecs; n++) {
1155 specPtr = specArr + n;
1156 if ((c == specPtr->name[0]) &&
1157 (strncmp(string, specPtr->name, length) == 0)) {
1158 Tcl_AppendResult(interp, " ", specPtr->name, (char *)NULL);
1159 }
1160 }
1161 return NULL;
1162
1163 } else if (n == -1) { /* Can't find operation, display help */
1164 Tcl_AppendResult(interp, "bad", (char *)NULL);
1165 if (operPos > 2) {
1166 Tcl_AppendResult(interp, " ", Tcl_GetString(objv[operPos - 1]),
1167 (char *)NULL);
1168 }
1169 Tcl_AppendResult(interp, " operation \"", string, "\": ", (char *)NULL);
1170 goto usage;
1171 }
1172 specPtr = specArr + n;
1173 if ((objc < specPtr->minArgs) ||
1174 ((specPtr->maxArgs > 0) && (objc > specPtr->maxArgs))) {
1175 Tcl_AppendResult(interp, "wrong # args: should be \"", (char *)NULL);
1176 for (i = 0; i < operPos; i++) {
1177 Tcl_AppendResult(interp, Tcl_GetString(objv[i]), " ",
1178 (char *)NULL);
1179 }
1180 Tcl_AppendResult(interp, specPtr->name, " ", specPtr->usage, "\"",
1181 (char *)NULL);
1182 return NULL;
1183 }
1184 return specPtr->proc;
1185}
1186
1187#endif
1188
1189#include <stdio.h>
1190
1191/* open a file
1192 * calculate the CRC32 of the entire contents
1193 * return the CRC
1194 * if there is an error rdet the global variable Crcerror
1195 */
1196
1197/* ---------------------------------------------------------------- */
1198
1199/* this is the CRC32 lookup table
1200 * thanks Gary S. Brown
1201 * 64 lines of 4 values for a 256 dword table (1024 bytes)
1202 */
1203static unsigned long crcTab[256] =
1204{ /* CRC polynomial 0xedb88320 */
1205 0x00000000UL, 0x77073096UL, 0xee0e612cUL, 0x990951baUL,
1206 0x076dc419UL, 0x706af48fUL, 0xe963a535UL, 0x9e6495a3UL,
1207 0x0edb8832UL, 0x79dcb8a4UL, 0xe0d5e91eUL, 0x97d2d988UL,
1208 0x09b64c2bUL, 0x7eb17cbdUL, 0xe7b82d07UL, 0x90bf1d91UL,
1209 0x1db71064UL, 0x6ab020f2UL, 0xf3b97148UL, 0x84be41deUL,
1210 0x1adad47dUL, 0x6ddde4ebUL, 0xf4d4b551UL, 0x83d385c7UL,
1211 0x136c9856UL, 0x646ba8c0UL, 0xfd62f97aUL, 0x8a65c9ecUL,
1212 0x14015c4fUL, 0x63066cd9UL, 0xfa0f3d63UL, 0x8d080df5UL,
1213 0x3b6e20c8UL, 0x4c69105eUL, 0xd56041e4UL, 0xa2677172UL,
1214 0x3c03e4d1UL, 0x4b04d447UL, 0xd20d85fdUL, 0xa50ab56bUL,
1215 0x35b5a8faUL, 0x42b2986cUL, 0xdbbbc9d6UL, 0xacbcf940UL,
1216 0x32d86ce3UL, 0x45df5c75UL, 0xdcd60dcfUL, 0xabd13d59UL,
1217 0x26d930acUL, 0x51de003aUL, 0xc8d75180UL, 0xbfd06116UL,
1218 0x21b4f4b5UL, 0x56b3c423UL, 0xcfba9599UL, 0xb8bda50fUL,
1219 0x2802b89eUL, 0x5f058808UL, 0xc60cd9b2UL, 0xb10be924UL,
1220 0x2f6f7c87UL, 0x58684c11UL, 0xc1611dabUL, 0xb6662d3dUL,
1221 0x76dc4190UL, 0x01db7106UL, 0x98d220bcUL, 0xefd5102aUL,
1222 0x71b18589UL, 0x06b6b51fUL, 0x9fbfe4a5UL, 0xe8b8d433UL,
1223 0x7807c9a2UL, 0x0f00f934UL, 0x9609a88eUL, 0xe10e9818UL,
1224 0x7f6a0dbbUL, 0x086d3d2dUL, 0x91646c97UL, 0xe6635c01UL,
1225 0x6b6b51f4UL, 0x1c6c6162UL, 0x856530d8UL, 0xf262004eUL,
1226 0x6c0695edUL, 0x1b01a57bUL, 0x8208f4c1UL, 0xf50fc457UL,
1227 0x65b0d9c6UL, 0x12b7e950UL, 0x8bbeb8eaUL, 0xfcb9887cUL,
1228 0x62dd1ddfUL, 0x15da2d49UL, 0x8cd37cf3UL, 0xfbd44c65UL,
1229 0x4db26158UL, 0x3ab551ceUL, 0xa3bc0074UL, 0xd4bb30e2UL,
1230 0x4adfa541UL, 0x3dd895d7UL, 0xa4d1c46dUL, 0xd3d6f4fbUL,
1231 0x4369e96aUL, 0x346ed9fcUL, 0xad678846UL, 0xda60b8d0UL,
1232 0x44042d73UL, 0x33031de5UL, 0xaa0a4c5fUL, 0xdd0d7cc9UL,
1233 0x5005713cUL, 0x270241aaUL, 0xbe0b1010UL, 0xc90c2086UL,
1234 0x5768b525UL, 0x206f85b3UL, 0xb966d409UL, 0xce61e49fUL,
1235 0x5edef90eUL, 0x29d9c998UL, 0xb0d09822UL, 0xc7d7a8b4UL,
1236 0x59b33d17UL, 0x2eb40d81UL, 0xb7bd5c3bUL, 0xc0ba6cadUL,
1237 0xedb88320UL, 0x9abfb3b6UL, 0x03b6e20cUL, 0x74b1d29aUL,
1238 0xead54739UL, 0x9dd277afUL, 0x04db2615UL, 0x73dc1683UL,
1239 0xe3630b12UL, 0x94643b84UL, 0x0d6d6a3eUL, 0x7a6a5aa8UL,
1240 0xe40ecf0bUL, 0x9309ff9dUL, 0x0a00ae27UL, 0x7d079eb1UL,
1241 0xf00f9344UL, 0x8708a3d2UL, 0x1e01f268UL, 0x6906c2feUL,
1242 0xf762575dUL, 0x806567cbUL, 0x196c3671UL, 0x6e6b06e7UL,
1243 0xfed41b76UL, 0x89d32be0UL, 0x10da7a5aUL, 0x67dd4accUL,
1244 0xf9b9df6fUL, 0x8ebeeff9UL, 0x17b7be43UL, 0x60b08ed5UL,
1245 0xd6d6a3e8UL, 0xa1d1937eUL, 0x38d8c2c4UL, 0x4fdff252UL,
1246 0xd1bb67f1UL, 0xa6bc5767UL, 0x3fb506ddUL, 0x48b2364bUL,
1247 0xd80d2bdaUL, 0xaf0a1b4cUL, 0x36034af6UL, 0x41047a60UL,
1248 0xdf60efc3UL, 0xa867df55UL, 0x316e8eefUL, 0x4669be79UL,
1249 0xcb61b38cUL, 0xbc66831aUL, 0x256fd2a0UL, 0x5268e236UL,
1250 0xcc0c7795UL, 0xbb0b4703UL, 0x220216b9UL, 0x5505262fUL,
1251 0xc5ba3bbeUL, 0xb2bd0b28UL, 0x2bb45a92UL, 0x5cb36a04UL,
1252 0xc2d7ffa7UL, 0xb5d0cf31UL, 0x2cd99e8bUL, 0x5bdeae1dUL,
1253 0x9b64c2b0UL, 0xec63f226UL, 0x756aa39cUL, 0x026d930aUL,
1254 0x9c0906a9UL, 0xeb0e363fUL, 0x72076785UL, 0x05005713UL,
1255 0x95bf4a82UL, 0xe2b87a14UL, 0x7bb12baeUL, 0x0cb61b38UL,
1256 0x92d28e9bUL, 0xe5d5be0dUL, 0x7cdcefb7UL, 0x0bdbdf21UL,
1257 0x86d3d2d4UL, 0xf1d4e242UL, 0x68ddb3f8UL, 0x1fda836eUL,
1258 0x81be16cdUL, 0xf6b9265bUL, 0x6fb077e1UL, 0x18b74777UL,
1259 0x88085ae6UL, 0xff0f6a70UL, 0x66063bcaUL, 0x11010b5cUL,
1260 0x8f659effUL, 0xf862ae69UL, 0x616bffd3UL, 0x166ccf45UL,
1261 0xa00ae278UL, 0xd70dd2eeUL, 0x4e048354UL, 0x3903b3c2UL,
1262 0xa7672661UL, 0xd06016f7UL, 0x4969474dUL, 0x3e6e77dbUL,
1263 0xaed16a4aUL, 0xd9d65adcUL, 0x40df0b66UL, 0x37d83bf0UL,
1264 0xa9bcae53UL, 0xdebb9ec5UL, 0x47b2cf7fUL, 0x30b5ffe9UL,
1265 0xbdbdf21cUL, 0xcabac28aUL, 0x53b39330UL, 0x24b4a3a6UL,
1266 0xbad03605UL, 0xcdd70693UL, 0x54de5729UL, 0x23d967bfUL,
1267 0xb3667a2eUL, 0xc4614ab8UL, 0x5d681b02UL, 0x2a6f2b94UL,
1268 0xb40bbe37UL, 0xc30c8ea1UL, 0x5a05df1bUL, 0x2d02ef8dUL
1269};
1270
1271#define CRC32(c, b) (crcTab[((int)(c) ^ (b)) & 0xff] ^ ((c) >> 8))
1272#define DO1(buf) crc = CRC32(crc, *buf++)
1273#define DO2(buf) DO1(buf); DO1(buf)
1274#define DO4(buf) DO2(buf); DO2(buf)
1275#define DO8(buf) DO4(buf); DO4(buf)
1276
1277static int
1278Crc32Cmd(
1279 ClientData clientData,
1280 Tcl_Interp *interp,
1281 int argc, char **argv)
1282{
1283 register unsigned int crc;
1284 char buf[200];
1285
1286 crc = 0L;
1287 crc = crc ^ 0xffffffffL;
1288 if (strcmp(argv[1], "-data") == 0) {
1289 register char *p;
1290
1291 if (argc != 3) {
1292 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
1293 " ?fileName? ?-data dataString?", (char *)NULL);
1294 return TCL_ERROR;
1295 }
1296 for (p = argv[2]; *p != '\0'; p++) {
1297 crc = CRC32(crc, *p);
1298 }
1299 } else {
1300 register int c;
1301 FILE *f;
1302
1303 if (argc != 2) {
1304 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
1305 " ?fileName? ?-data dataString?", (char *)NULL);
1306 return TCL_ERROR;
1307 }
1308 f = fopen(argv[1], "rb");
1309 if (f == NULL) {
1310 Tcl_AppendResult(interp, "can't open file \"", argv[1], "\": ",
1311 Tcl_PosixError(interp), (char *)NULL);
1312 return TCL_ERROR;
1313 }
1314 while((c = getc(f)) != EOF) {
1315 crc = CRC32(crc, c);
1316 }
1317 fclose(f);
1318 }
1319 crc = crc ^ 0xffffffffL;
1320 sprintf(buf, "%x", crc);
1321 Tcl_SetResult(interp, buf, TCL_VOLATILE);
1322 return TCL_OK;
1323}
1324
1325int
1326Blt_Crc32Init(interp)
1327 Tcl_Interp *interp;
1328{
1329 static Blt_CmdSpec cmdSpec = {"crc32", Crc32Cmd,};
1330
1331 if (Blt_InitCmd(interp, "blt", &cmdSpec) == NULL) {
1332 return TCL_ERROR;
1333 }
1334 return TCL_OK;
1335}
1336
Note: See TracBrowser for help on using the repository browser.