1
2 /*
3 * bltInit.c --
4 *
5 * This module initials the BLT toolkit, registering its commands
6 * with the Tcl/Tk interpreter.
7 *
8 * Copyright 1991-1998 Lucent Technologies, Inc.
9 *
10 * Permission to use, copy, modify, and distribute this software and
11 * its documentation for any purpose and without fee is hereby
12 * granted, provided that the above copyright notice appear in all
13 * copies and that both that the copyright notice and warranty
14 * disclaimer appear in supporting documentation, and that the names
15 * of Lucent Technologies any of their entities not be used in
16 * advertising or publicity pertaining to distribution of the software
17 * without specific, written prior permission.
18 *
19 * Lucent Technologies disclaims all warranties with regard to this
20 * software, including all implied warranties of merchantability and
21 * fitness. In no event shall Lucent Technologies be liable for any
22 * special, indirect or consequential damages or any damages
23 * whatsoever resulting from loss of use, data or profits, whether in
24 * an action of contract, negligence or other tortuous action, arising
25 * out of or in connection with the use or performance of this
26 * software.
27 */
28
29 #include <bltInt.h>
30 #include <bltTile.h>
31
32 #define EXACT 1
33
34 #ifndef BLT_LIBRARY
35 #ifdef WIN32
36 #define BLT_LIBRARY "c:/Program Files/Tcl/lib/blt"##BLT_VERSION
37 #else
38 #define BLT_LIBRARY "unknown"
39 #endif
40 #endif
41
42 #define BLT_THREAD_KEY "BLT Initialized"
43 #define BLT_TCL_CMDS (1<<0)
44 #define BLT_TK_CMDS (1<<1)
45
46 double bltNaN;
47 #if (TCL_MAJOR_VERSION > 7)
48 #endif
49
50 static Tcl_MathProc MinMathProc, MaxMathProc;
51 static char libPath[1024] =
52 {
53 BLT_LIBRARY
54 };
55
56 /*
57 * Script to set the BLT library path in the variable global "blt_library"
58 *
59 * Checks the usual locations for a file (bltGraph.pro) from the BLT
60 * library. The places searched in order are
61 *
62 * $BLT_LIBRARY
63 * $BLT_LIBRARY/blt2.5
64 * $BLT_LIBRARY/..
65 * $BLT_LIBRARY/../blt2.5
66 * $blt_libPath
67 * $blt_libPath/blt2.5
68 * $blt_libPath/..
69 * $blt_libPath/../blt2.5
70 * $tcl_library
71 * $tcl_library/blt2.5
72 * $tcl_library/..
73 * $tcl_library/../blt2.5
74 * $env(TCL_LIBRARY)
75 * $env(TCL_LIBRARY)/blt2.5
76 * $env(TCL_LIBRARY)/..
77 * $env(TCL_LIBRARY)/../blt2.5
78 *
79 * The Tcl variable "blt_library" is set to the discovered path.
80 * If the file wasn't found, no error is returned. The actual
81 * usage of $blt_library is purposely deferred so that it can be
82 * set from within a script.
83 */
84
85 /* FIXME: Change this to a namespace procedure in 3.0 */
86
87 static char initScript[] =
88 {"\n\
89 global blt_library blt_libPath blt_version tcl_library env\n\
90 set blt_library {}\n\
91 set path {}\n\
92 foreach var { env(BLT_LIBRARY) blt_libPath tcl_library env(TCL_LIBRARY) } { \n\
93 if { ![info exists $var] } { \n\
94 continue \n\
95 } \n\
96 set path [set $var] \n\
97 if { [file readable [file join $path bltGraph.pro]] } { \n\
98 set blt_library $path\n\
99 break \n\
100 } \n\
101 set path [file join $path blt$blt_version ] \n\
102 if { [file readable [file join $path bltGraph.pro]] } { \n\
103 set blt_library $path\n\
104 break \n\
105 } \n\
106 set path [file dirname [set $var]] \n\
107 if { [file readable [file join $path bltGraph.pro]] } { \n\
108 set blt_library $path\n\
109 break \n\
110 } \n\
111 set path [file join $path blt$blt_version ] \n\
112 if { [file readable [file join $path bltGraph.pro]] } { \n\
113 set blt_library $path\n\
114 break \n\
115 } \n\
116 } \n\
117 if { $blt_library != \"\" } { \n\
118 global auto_path \n\
119 lappend auto_path $blt_library \n\
120 if { [file exists [file join $blt_library init.tcl]] } {\n\
121 source [file join $blt_library init.tcl]\n\
122 }\n\
123 }\n\
124 unset var path\n\
125 \n"
126 };
127
128
129 static Tcl_AppInitProc *tclCmds[] =
130 {
131 #ifndef NO_BGEXEC
132 Blt_BgexecInit,
133 #endif
134 #ifndef NO_DEBUG
135 Blt_DebugInit,
136 #endif
137 #ifndef NO_WATCH
138 Blt_WatchInit,
139 #endif
140 #ifndef NO_VECTOR
141 Blt_VectorInit,
142 #endif
143 #ifndef NO_SPLINE
144 Blt_SplineInit,
145 #endif
146 #ifndef NO_TREE
147 Blt_TreeInit,
148 #endif
149 #ifndef NO_DDE
150 Blt_DdeInit,
151 #endif
152 #ifndef NO_CRC32
153 Blt_Crc32Init,
154 #endif
155 (Tcl_AppInitProc *) NULL
156 };
157
158 #ifndef TCL_ONLY
159 static Tcl_AppInitProc *tkCmds[] =
160 {
161 #ifndef NO_GRAPH
162 Blt_GraphInit,
163 #endif
164 #ifndef NO_TABLE
165 Blt_TableInit,
166 #endif
167 #ifndef NO_HIERBOX
168 Blt_HierboxInit,
169 #endif
170 #ifndef NO_TABSET
171 Blt_TabsetInit,
172 #endif
173 #ifndef NO_TABNOTEBOOK
174 Blt_TabnotebookInit,
175 #endif
176 #ifndef NO_HTEXT
177 Blt_HtextInit,
178 #endif
179 #ifndef NO_BUSY
180 Blt_BusyInit,
181 #endif
182 #ifndef NO_WINOP
183 Blt_WinopInit,
184 #endif
185 #ifndef NO_BITMAP
186 Blt_BitmapInit,
187 #endif
188 #ifndef NO_DRAGDROP
189 Blt_DragDropInit,
190 #endif
191 #ifndef NO_DND
192 Blt_DndInit,
193 #endif
194 #ifndef NO_CONTAINER
195 Blt_ContainerInit,
196 #endif
197 #ifndef NO_BELL
198 Blt_BeepInit,
199 #endif
200 #ifndef NO_CUTBUFFER
201 Blt_CutbufferInit,
202 #endif
203 #ifndef NO_PRINTER
204 Blt_PrinterInit,
205 #endif
206 #ifndef NO_TILEFRAME
207 Blt_FrameInit,
208 #endif
209 #ifndef NO_TILEBUTTON
210 Blt_ButtonInit,
211 #endif
212 #ifndef NO_TILESCROLLBAR
213 Blt_ScrollbarInit,
214 #endif
215 #ifndef NO_TREEVIEW
216 Blt_TreeViewInit,
217 #endif
218 #if (BLT_MAJOR_VERSION == 3)
219 #ifndef NO_MOUNTAIN
220 Blt_MountainInit,
221 #endif
222 #endif
223 #ifndef NO_TED
224 Blt_TedInit,
225 #endif
226 (Tcl_AppInitProc *) NULL
227 };
228 #endif /* TCL_ONLY */
229
230 #ifdef WIN32
231 /*
232 *----------------------------------------------------------------------
233 *
234 * DllMain --
235 *
236 * This wrapper function is used by Windows to invoke the
237 * initialization code for the DLL.
238 *
239 * Results:
240 * Returns TRUE;
241 *
242 * Side effects:
243 * None.
244 *
245 *----------------------------------------------------------------------
246 */
247 BOOL APIENTRY
DllMain(HINSTANCE hInst,DWORD reason,LPVOID reserved)248 DllMain(
249 HINSTANCE hInst, /* Library instance handle. */
250 DWORD reason, /* Reason this function is being called. */
251 LPVOID reserved) /* Not used. */
252 {
253 return TRUE;
254 }
255
256 #ifndef STATIC_BUILD
257 BOOL APIENTRY
DllEntryPoint(hInst,reason,reserved)258 DllEntryPoint(hInst, reason, reserved)
259 HINSTANCE hInst; /* Library instance handle. */
260 DWORD reason; /* Reason this function is being called. */
261 LPVOID reserved; /* Not used. */
262 {
263 return DllMain(hInst, reason, reserved);
264 }
265 #endif
266 #endif /* WIN32 */
267
268
269 #ifdef __BORLANDC__
270 static double
MakeNaN(void)271 MakeNaN(void)
272 {
273 union Real {
274 struct DoubleWord {
275 int lo, hi;
276 } doubleWord;
277 double number;
278 } real;
279
280 real.doubleWord.lo = real.doubleWord.hi = 0x7FFFFFFF;
281 return real.number;
282 }
283 #endif /* __BORLANDC__ */
284
285 #ifdef _MSC_VER
286 static double
MakeNaN(void)287 MakeNaN(void)
288 {
289 return sqrt(-1.0); /* Generate IEEE 754 Quiet Not-A-Number. */
290 }
291 #endif /* _MSC_VER */
292
293 #if !defined(__BORLANDC__) && !defined(_MSC_VER)
294 static double
MakeNaN(void)295 MakeNaN(void)
296 {
297 return 0.0 / 0.0; /* Generate IEEE 754 Not-A-Number. */
298 }
299 #endif /* !__BORLANDC__ && !_MSC_VER */
300
301
302 /* ARGSUSED */
303 static int
MinMathProc(clientData,interp,argsPtr,resultPtr)304 MinMathProc(clientData, interp, argsPtr, resultPtr)
305 ClientData clientData; /* Not used. */
306 Tcl_Interp *interp;
307 Tcl_Value *argsPtr;
308 Tcl_Value *resultPtr;
309 {
310 Tcl_Value *op1Ptr, *op2Ptr;
311
312 op1Ptr = argsPtr, op2Ptr = argsPtr + 1;
313 if ((op1Ptr->type == TCL_INT) && (op2Ptr->type == TCL_INT)) {
314 resultPtr->intValue = MIN(op1Ptr->intValue, op2Ptr->intValue);
315 resultPtr->type = TCL_INT;
316 } else {
317 double a, b;
318
319 a = (op1Ptr->type == TCL_INT)
320 ? (double)op1Ptr->intValue : op1Ptr->doubleValue;
321 b = (op2Ptr->type == TCL_INT)
322 ? (double)op2Ptr->intValue : op2Ptr->doubleValue;
323 resultPtr->doubleValue = MIN(a, b);
324 resultPtr->type = TCL_DOUBLE;
325 }
326 return TCL_OK;
327 }
328
329 /*ARGSUSED*/
330 static int
MaxMathProc(clientData,interp,argsPtr,resultPtr)331 MaxMathProc(clientData, interp, argsPtr, resultPtr)
332 ClientData clientData; /* Not Used. */
333 Tcl_Interp *interp;
334 Tcl_Value *argsPtr;
335 Tcl_Value *resultPtr;
336 {
337 Tcl_Value *op1Ptr, *op2Ptr;
338
339 op1Ptr = argsPtr, op2Ptr = argsPtr + 1;
340 if ((op1Ptr->type == TCL_INT) && (op2Ptr->type == TCL_INT)) {
341 resultPtr->intValue = MAX(op1Ptr->intValue, op2Ptr->intValue);
342 resultPtr->type = TCL_INT;
343 } else {
344 double a, b;
345
346 a = (op1Ptr->type == TCL_INT)
347 ? (double)op1Ptr->intValue : op1Ptr->doubleValue;
348 b = (op2Ptr->type == TCL_INT)
349 ? (double)op2Ptr->intValue : op2Ptr->doubleValue;
350 resultPtr->doubleValue = MAX(a, b);
351 resultPtr->type = TCL_DOUBLE;
352 }
353 return TCL_OK;
354 }
355
356 #ifndef TCL_ONLY
357 void
Blt_TileRectangleOrigin(Tk_Window tkwin,Drawable drawable,ClientData tilePtr,int x,int y,unsigned int width,unsigned int height,int xofs,int yofs,int flags)358 Blt_TileRectangleOrigin(
359 Tk_Window tkwin,
360 Drawable drawable,
361 ClientData tilePtr,
362 int x, int y,
363 unsigned int width,
364 unsigned int height,
365 int xofs, int yofs, int flags)
366 {
367
368 if (flags&1) {
369 Blt_SetTSOrigin(tkwin, tilePtr, xofs, yofs);
370 } else if (flags&2) {
371 Blt_SetTileOrigin(tkwin, tilePtr, xofs, yofs);
372 } else {
373 Blt_SetTileOrigin(tkwin, tilePtr, 0, 0);
374 }
375 Blt_TileRectangle(tkwin, drawable, tilePtr, x, y, width, height);
376 }
377
378 void
Blt_TilePolygonOrigin(Tk_Window tkwin,Drawable drawable,ClientData * clientPtr,XPoint pointArr[],int nPoints,int xofs,int yofs,int flags)379 Blt_TilePolygonOrigin(
380 Tk_Window tkwin, Drawable drawable,
381 ClientData *clientPtr, XPoint pointArr[], int nPoints, int xofs, int yofs, int flags)
382 {
383 Blt_Tile tilePtr = (Blt_Tile)clientPtr;
384 if (flags&1) {
385 Blt_SetTSOrigin(tkwin, tilePtr, xofs, yofs);
386 } else if (flags&2) {
387 Blt_SetTileOrigin(tkwin, tilePtr, xofs, yofs);
388 } else {
389 Blt_SetTileOrigin(tkwin, tilePtr, 0, 0);
390 }
391 Blt_TilePolygon(tkwin, drawable, tilePtr, pointArr, nPoints);
392 }
393
Blt_TileFlagsOrigin(ClientData clientPtr)394 int Blt_TileFlagsOrigin(ClientData clientPtr) {
395 Blt_Tile tilePtr = (Blt_Tile)clientPtr;
396 return Blt_TileFlags(tilePtr);
397 }
398
Blt_TileHasOrigin(ClientData clientPtr)399 int Blt_TileHasOrigin(ClientData clientPtr) {
400 Blt_Tile tilePtr = (Blt_Tile)clientPtr;
401 return Blt_HasTile(tilePtr);
402 }
403
404
405 /* Register the tile handlers with Tk. */
406 static struct TileHandlers {
407 int magic;
408 int (*Tk_TileHasProcPtr)(ClientData tile);
409 int (*Tk_TileFlagsProcPtr)(ClientData tile);
410 void (*Tk_TileRectangleProcPtr) (Tk_Window tkwin, Drawable drawable,
411 ClientData tile, int x, int y, int width, int height, int xofs, int yofs, int flags);
412 void (*Tk_TilePolygonProcPtr)( Tk_Window tkwin, Drawable drawable,
413 ClientData *clientPtr, XPoint pointArr[], int nPoints,
414 int xofs, int yofs, int flags);
415 void (*Tk_FreeTileProcPtr)(ClientData clientData);
416 void (*Tk_SetTileChangedProcPtr)( ClientData tile,
417 /* TkWorldUpdateProc */ char *procPtr, ClientData clientData);
418 Tk_CustomOption *TileOption;
419 Tk_ObjCustomOption *CustomTileOption;
420
421 } TileHandlerFuncs = {
422 0x77711101,
423 (void*)Blt_TileHasOrigin,
424 (void*)Blt_TileFlagsOrigin,
425 (void*)Blt_TileRectangleOrigin,
426 (void*)Blt_TilePolygonOrigin,
427 (void*)Blt_FreeTile,
428 (void*)Blt_SetTileChangedProc,
429 NULL,
430 NULL
431
432 };
433 #endif
434
435 static int
SetLibraryPath(interp)436 SetLibraryPath(interp)
437 Tcl_Interp *interp;
438 {
439 Tcl_DString dString;
440 CONST char *value;
441 static int tkisinit = 0;
442
443 #ifndef TCL_ONLY
444 if (!tkisinit) {
445 struct TileHandlers *thPtr;
446
447 tkisinit=1;
448 /* Register tile handlers with Tk. */
449 thPtr = (struct TileHandlers *)Tcl_GetAssocData(interp, "tkBgTileFuncs", NULL);
450 if (thPtr != NULL && thPtr->magic == 0x77711101 && thPtr->TileOption) {
451 *(thPtr->TileOption) = bltTileOption;
452 *(thPtr->CustomTileOption) = bltCustomTileOption;
453 *thPtr = TileHandlerFuncs;
454 }
455 }
456 #endif
457
458 Tcl_DStringInit(&dString);
459 Tcl_DStringAppend(&dString, libPath, -1);
460 #ifdef WIN32
461 {
462 HKEY key;
463 DWORD result;
464 #ifndef BLT_REGISTRY_KEY
465 #define BLT_REGISTRY_KEY "Software\\BLT\\" BLT_VERSION "\\" TCL_VERSION
466 #endif
467 result = RegOpenKeyEx(
468 HKEY_LOCAL_MACHINE, /* Parent key. */
469 BLT_REGISTRY_KEY, /* Path to sub-key. */
470 0, /* Reserved. */
471 KEY_READ, /* Security access mask. */
472 &key); /* Resulting key.*/
473
474 if (result == ERROR_SUCCESS) {
475 DWORD size;
476
477 /* Query once to get the size of the string needed */
478 result = RegQueryValueEx(key, "BLT_LIBRARY", NULL, NULL, NULL,
479 &size);
480 if (result == ERROR_SUCCESS) {
481 Tcl_DStringSetLength(&dString, size);
482 /* And again to collect the string. */
483 RegQueryValueEx(key, "BLT_LIBRARY", NULL, NULL,
484 (LPBYTE)Tcl_DStringValue(&dString), &size);
485 RegCloseKey(key);
486 }
487 }
488 }
489 #endif /* WIN32 */
490 value = Tcl_SetVar(interp, "blt_libPath", Tcl_DStringValue(&dString),
491 TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
492 Tcl_DStringFree(&dString);
493 if (value == NULL) {
494 return TCL_ERROR;
495 }
496 return TCL_OK;
497 }
498
499 #if (TCL_MAJOR_VERSION > 7)
500
501 #include "bltDecls.h"
502
503 #ifdef USE_BLT_STUBS
504 extern BltStubs bltStubs;
505 #endif
506
507 /*LINTLIBRARY*/
508 EXPORT int
Blt_Init(interp)509 Blt_Init(interp)
510 Tcl_Interp *interp; /* Interpreter to add extra commands */
511 {
512 int flags;
513
514 flags = (int)Tcl_GetAssocData(interp, BLT_THREAD_KEY, NULL);
515 if ((flags & BLT_TCL_CMDS) == 0) {
516 register Tcl_AppInitProc **p;
517 Tcl_Namespace *nsPtr;
518 Tcl_ValueType args[2];
519
520 /*
521 * Check that the versions of Tcl that have been loaded are
522 * the same ones that BLT was compiled against.
523 */
524 if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 0) == NULL) {
525 return TCL_ERROR;
526 }
527 /* Set the "blt_version", "blt_patchLevel", and "blt_libPath" Tcl
528 * variables. We'll use them in the following script. */
529 if ((Tcl_SetVar(interp, "blt_version", BLT_VERSION,
530 TCL_GLOBAL_ONLY) == NULL) ||
531 (Tcl_SetVar(interp, "blt_patchLevel", BLT_PATCH_LEVEL,
532 TCL_GLOBAL_ONLY) == NULL)) {
533 return TCL_ERROR;
534 }
535 if (SetLibraryPath(interp) != TCL_OK) {
536 return TCL_ERROR;
537 }
538 nsPtr = Tcl_CreateNamespace(interp, "blt", NULL,
539 (Tcl_NamespaceDeleteProc *) NULL);
540 if (nsPtr == NULL) {
541 return TCL_ERROR;
542 }
543 if (Tcl_Eval(interp, initScript) != TCL_OK) {
544 return TCL_ERROR;
545 }
546 #ifdef USE_BLT_STUBS
547 if (dostub) {
548 Blt_InitStubs(interp, 0, 0);
549 }
550 #endif
551 /* Initialize the BLT commands that only require Tcl. */
552 for (p = tclCmds; *p != NULL; p++) {
553 if ((**p) (interp) != TCL_OK) {
554 Tcl_DeleteNamespace(nsPtr);
555 return TCL_ERROR;
556 }
557 }
558 args[0] = args[1] = TCL_EITHER;
559 Tcl_CreateMathFunc(interp, "min", 2, args, MinMathProc, (ClientData)0);
560 Tcl_CreateMathFunc(interp, "max", 2, args, MaxMathProc, (ClientData)0);
561 Blt_RegisterArrayObj(interp);
562 bltNaN = MakeNaN();
563 #ifdef USE_BLT_STUBS
564 if (Tcl_PkgProvideEx(interp, "BLT", BLT_VERSION, &bltStubs) != TCL_OK) {
565 return TCL_ERROR;
566 }
567 #else
568 if (Tcl_PkgProvideEx(interp, "BLT", BLT_VERSION, NULL) != TCL_OK) {
569 return TCL_ERROR;
570 }
571 #endif
572 Tcl_SetAssocData(interp, BLT_THREAD_KEY, NULL,
573 (ClientData)(flags | BLT_TCL_CMDS));
574 }
575 #ifndef TCL_ONLY
576 if ((flags & BLT_TK_CMDS) == 0) {
577 register Tcl_AppInitProc **p;
578 Tcl_Namespace *nsPtr;
579
580 #if ((TCL_VERSION_NUMBER >= _VERSION(8,1,0)) && (TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE))
581 if (Tcl_PkgPresent(interp, "Tk", TK_VERSION, 0) == NULL) {
582 return TCL_OK;
583 }
584 #else
585 if (Tcl_PkgRequire(interp, "Tk", TK_VERSION, 0) == NULL) {
586 Tcl_ResetResult(interp);
587 return TCL_OK;
588 }
589 #endif
590 nsPtr = Tcl_CreateNamespace(interp, "blt::tile", NULL,
591 (Tcl_NamespaceDeleteProc *) NULL);
592 if (nsPtr == NULL) {
593 return TCL_ERROR;
594 }
595 nsPtr = Tcl_FindNamespace(interp, "blt", (Tcl_Namespace *)NULL,
596 TCL_LEAVE_ERR_MSG);
597 if (nsPtr == NULL ) {
598 return TCL_ERROR;
599 }
600 /* Initialize the BLT commands that only use Tk too. */
601 for (p = tkCmds; *p != NULL; p++) {
602 if ((**p) (interp) != TCL_OK) {
603 Tcl_DeleteNamespace(nsPtr);
604 return TCL_ERROR;
605 }
606 }
607 Blt_InitEpsCanvasItem(interp);
608 Tcl_SetAssocData(interp, BLT_THREAD_KEY, NULL,
609 (ClientData)(flags | BLT_TK_CMDS));
610 }
611 #endif
612 return TCL_OK;
613 }
614
615 #else
616
617 /*LINTLIBRARY*/
618 EXPORT int
Blt_Init(interp)619 Blt_Init(interp)
620 Tcl_Interp *interp; /* Interpreter to add extra commands */
621 {
622 int flags;
623
624 flags = (int)Tcl_GetAssocData(interp, BLT_THREAD_KEY, NULL);
625 if ((flags & BLT_TCL_CMDS) == 0) {
626 register Tcl_AppInitProc **p;
627 Tcl_ValueType args[2];
628
629 /*
630 * Check that the versions of Tcl that have been loaded are
631 * the same ones that BLT was compiled against.
632 */
633 if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 0) == NULL) {
634 return TCL_ERROR;
635 }
636 /* Set the "blt_version", "blt_patchLevel", and "blt_libPath" Tcl
637 * variables. We'll use them in the following script. */
638 if ((Tcl_SetVar(interp, "blt_version", BLT_VERSION,
639 TCL_GLOBAL_ONLY) == NULL) ||
640 (Tcl_SetVar(interp, "blt_patchLevel", BLT_PATCH_LEVEL,
641 TCL_GLOBAL_ONLY) == NULL)) {
642 return TCL_ERROR;
643 }
644 if (SetLibraryPath(interp) != TCL_OK) {
645 return TCL_ERROR;
646 }
647 if (Tcl_Eval(interp, initScript) != TCL_OK) {
648 return TCL_ERROR;
649 }
650 /* Initialize the BLT commands that only require Tcl. */
651 for (p = tclCmds; *p != NULL; p++) {
652 if ((**p) (interp) != TCL_OK) {
653 return TCL_ERROR;
654 }
655 }
656 args[0] = args[1] = TCL_EITHER;
657 Tcl_CreateMathFunc(interp, "min", 2, args, MinMathProc, (ClientData)0);
658 Tcl_CreateMathFunc(interp, "max", 2, args, MaxMathProc, (ClientData)0);
659 bltNaN = MakeNaN();
660 if (Tcl_PkgProvide(interp, "BLT", BLT_VERSION) != TCL_OK) {
661 return TCL_ERROR;
662 }
663 Tcl_SetAssocData(interp, BLT_THREAD_KEY, NULL,
664 (ClientData)(flags | BLT_TCL_CMDS));
665 }
666 #ifndef TCL_ONLY
667 if ((flags & BLT_TK_CMDS) == 0) {
668 register Tcl_AppInitProc **p;
669
670 #if (TCL_VERSION_NUMBER >= _VERSION(8,1,0))
671 if (Tcl_PkgPresent(interp, "Tk", TK_VERSION, 0) == NULL) {
672 return TCL_OK;
673 }
674 #else
675 if (Tcl_PkgRequire(interp, "Tk", TK_VERSION, 0) == NULL) {
676 Tcl_ResetResult(interp);
677 return TCL_OK;
678 }
679 #endif
680 /* Initialize the BLT commands that use Tk too. */
681 for (p = tkCmds; *p != NULL; p++) {
682 if ((**p) (interp) != TCL_OK) {
683 return TCL_ERROR;
684 }
685 }
686 Blt_InitEpsCanvasItem(interp);
687 Tcl_SetAssocData(interp, BLT_THREAD_KEY, NULL,
688 (ClientData)(flags | BLT_TK_CMDS));
689 }
690 #endif
691 return TCL_OK;
692 }
693
694 #endif /* TCL_MAJOR_VERION >= 8 */
695
696 /*LINTLIBRARY*/
697 EXPORT int
Blt_SafeInit(interp)698 Blt_SafeInit(interp)
699 Tcl_Interp *interp; /* Interpreter to add extra commands */
700 {
701 return Blt_Init(interp);
702 }
703
704 /*
705 *----------------------------------------------------------------------
706 *
707 * Blt_InitCmd --
708 *
709 * Given the name of a command, return a pointer to the
710 * clientData field of the command.
711 *
712 * Results:
713 * A standard TCL result. If the command is found, TCL_OK
714 * is returned and clientDataPtr points to the clientData
715 * field of the command (if the clientDataPtr in not NULL).
716 *
717 * Side effects:
718 * If the command is found, clientDataPtr is set to the address
719 * of the clientData of the command. If not found, an error
720 * message is left in interp->result.
721 *
722 *----------------------------------------------------------------------
723 */
724
725 /*ARGSUSED*/
726 Tcl_Command
Blt_InitCmd(interp,nsName,specPtr)727 Blt_InitCmd(interp, nsName, specPtr)
728 Tcl_Interp *interp;
729 char *nsName;
730 Blt_CmdSpec *specPtr;
731 {
732 char *cmdPath;
733 Tcl_DString dString;
734 Tcl_Command cmdToken;
735
736 Tcl_DStringInit(&dString);
737 #if HAVE_NAMESPACES
738 if (nsName != NULL) {
739 Tcl_DStringAppend(&dString, nsName, -1);
740 }
741 Tcl_DStringAppend(&dString, "::", -1);
742 #endif /* HAVE_NAMESPACES */
743 Tcl_DStringAppend(&dString, specPtr->name, -1);
744
745 cmdPath = Tcl_DStringValue(&dString);
746 cmdToken = Tcl_FindCommand(interp, cmdPath, (Tcl_Namespace *)NULL, 0);
747 if (cmdToken != NULL) {
748 Tcl_DStringFree(&dString);
749 return cmdToken; /* Assume command was already initialized */
750 }
751 cmdToken = Tcl_CreateCommand(interp, cmdPath, specPtr->cmdProc,
752 specPtr->clientData, specPtr->cmdDeleteProc);
753 Tcl_DStringFree(&dString);
754
755 #if (HAVE_NAMESPACES) && (TCL_MAJOR_VERSION > 7)
756 {
757 Tcl_Namespace *nsPtr;
758 int dontResetList = 0;
759
760 nsPtr = Tcl_FindNamespace(interp, nsName, (Tcl_Namespace *)NULL,
761 TCL_LEAVE_ERR_MSG);
762 if (nsPtr == NULL) {
763 return NULL;
764 }
765 if (Tcl_Export(interp, nsPtr, specPtr->name, dontResetList) != TCL_OK) {
766 return NULL;
767 }
768 }
769 #endif /* TCL_MAJOR_VERSION > 7 */
770 return cmdToken;
771 }
772
773 #if (TCL_MAJOR_VERSION > 7)
774 /*
775 *----------------------------------------------------------------------
776 *
777 * Blt_InitObjCmd --
778 *
779 * Given the name of a command, return a pointer to the
780 * clientData field of the command.
781 *
782 * Results:
783 * A standard TCL result. If the command is found, TCL_OK
784 * is returned and clientDataPtr points to the clientData
785 * field of the command (if the clientDataPtr in not NULL).
786 *
787 * Side effects:
788 * If the command is found, clientDataPtr is set to the address
789 * of the clientData of the command. If not found, an error
790 * message is left in interp->result.
791 *
792 *----------------------------------------------------------------------
793 */
794 /*ARGSUSED*/
795 Tcl_Command
Blt_InitObjCmd(interp,nsName,specPtr)796 Blt_InitObjCmd(interp, nsName, specPtr)
797 Tcl_Interp *interp;
798 char *nsName;
799 Blt_ObjCmdSpec *specPtr;
800 {
801 char *cmdPath;
802 Tcl_DString dString;
803 Tcl_Command cmdToken;
804 Tcl_Namespace *nsPtr;
805
806 Tcl_DStringInit(&dString);
807 if (nsName != NULL) {
808 Tcl_DStringAppend(&dString, nsName, -1);
809 }
810 Tcl_DStringAppend(&dString, "::", -1);
811 Tcl_DStringAppend(&dString, specPtr->name, -1);
812
813 cmdPath = Tcl_DStringValue(&dString);
814 cmdToken = Tcl_FindCommand(interp, cmdPath, (Tcl_Namespace *)NULL, 0);
815 if (cmdToken != NULL) {
816 Tcl_DStringFree(&dString);
817 return cmdToken; /* Assume command was already initialized */
818 }
819 cmdToken = Tcl_CreateObjCommand(interp, cmdPath,
820 (Tcl_ObjCmdProc *)specPtr->cmdProc,
821 specPtr->clientData,
822 specPtr->cmdDeleteProc);
823 Tcl_DStringFree(&dString);
824
825 nsPtr = Tcl_FindNamespace(interp, nsName, (Tcl_Namespace *)NULL,
826 TCL_LEAVE_ERR_MSG);
827 if (nsPtr == NULL) {
828 return NULL;
829 }
830 if (Tcl_Export(interp, nsPtr, specPtr->name, FALSE) != TCL_OK) {
831 return NULL;
832 }
833 return cmdToken;
834 }
835
836 #endif /* TCL_MAJOR_VERSION > 7 */
837
838 /*
839 *----------------------------------------------------------------------
840 *
841 * Blt_InitCmds --
842 *
843 * Given the name of a command, return a pointer to the
844 * clientData field of the command.
845 *
846 * Results:
847 * A standard TCL result. If the command is found, TCL_OK
848 * is returned and clientDataPtr points to the clientData
849 * field of the command (if the clientDataPtr in not NULL).
850 *
851 * Side effects:
852 * If the command is found, clientDataPtr is set to the address
853 * of the clientData of the command. If not found, an error
854 * message is left in interp->result.
855 *
856 *----------------------------------------------------------------------
857 */
858 int
Blt_InitCmds(interp,nsName,specPtr,nCmds)859 Blt_InitCmds(interp, nsName, specPtr, nCmds)
860 Tcl_Interp *interp;
861 char *nsName;
862 Blt_CmdSpec *specPtr;
863 int nCmds;
864 {
865 Blt_CmdSpec *endPtr;
866
867 for (endPtr = specPtr + nCmds; specPtr < endPtr; specPtr++) {
868 if (Blt_InitCmd(interp, nsName, specPtr) == NULL) {
869 return TCL_ERROR;
870 }
871 }
872 return TCL_OK;
873 }
874