00001
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041 #if HAVE_CONFIG_H
00042 #include <config.h>
00043 #endif
00044 #include <stdio.h>
00045 #include <tcl.h>
00046 #include <tk.h>
00047 #include <string.h>
00048 #include <unistd.h>
00049 #include <sadie.h>
00050 #include "tclsadie.h"
00051 #include "Sadie_Index.h"
00052
00057 #if HAVE_CONFIG_H
00058 static const char package[] = PACKAGE;
00059 static const char short_version[] = PACKAGE_STRING;
00060 #else
00061 static const char package[] = "tclsadie";
00062 static const char short_version[] = "tclSadie";
00063 #endif
00064 static const char verbose_version[] = "$Id: tclSadie.c,v 1.2 2005/03/25 04:05:10 mmunro Exp $";
00068 static const char lib_env_var_name[] = "TCLSADIE_HOME";
00069
00071 static const char main_file_name[] = "tclSadie_main.tcl";
00072
00074 static const char sadievar_arrayname[] = SADIEVAR_ARRAYNAME;
00075
00077 static char *libdirpath = NULL;
00078
00083 extern int Sadie_FileIO_Init (Tcl_Interp * interp);
00084 extern int Sadie_General_Init (Tcl_Interp * interp);
00085 extern int Sadie_Plot_Init (Tcl_Interp * interp);
00086 extern int Sadie_NewFunctions_Init (Tcl_Interp * interp);
00087 extern int Sadie_Contrast_Init (Tcl_Interp * interp);
00088 extern int Sadie_Filter_Init (Tcl_Interp * interp);
00089 extern int Sadie_Geometry_Init (Tcl_Interp * interp);
00090 extern int Sadie_Multi_Init (Tcl_Interp * interp);
00091 extern int Sadie_Classify_Init (Tcl_Interp * interp);
00092 extern int Sadie_Tools_Init (Tcl_Interp * interp);
00093 extern int Sadie_Image_Init (Tcl_Interp * interp);
00094 extern int Sadie_Proto_Init (Tcl_Interp * interp);
00098 sad_doclistp_t global_doclist;
00099
00110 #if (TCL_MAJOR_VERSION < 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION <= 3))
00111
00113 static Tcl_Interp * global_interpreter = NULL;
00114
00122 static int
00123 Tcl_FSConvertToPathType (Tcl_Interp * interp, Tcl_Obj * pathPtr)
00124 {
00125 return
00126 ((interp == NULL) || (pathPtr == NULL)
00127 || (Tcl_GetString (pathPtr) == NULL))
00128 ? TCL_ERROR
00129 : TCL_OK;
00130 }
00131
00145 static int
00146 Tcl_FSAccess (Tcl_Obj * pathPtr, int mode)
00147 {
00148 char *path = NULL;
00149 int status = -1;
00150
00151 if (pathPtr != NULL)
00152 {
00153 path = Tcl_GetString (pathPtr);
00154 if (path != NULL)
00155 status = Tcl_Access (path, mode);
00156 }
00157 return status;
00158 }
00159
00168 static Tcl_Obj *
00169 Tcl_FSSplitPath (Tcl_Obj * pathPtr, int * lenPtr)
00170 {
00171 int argc, objc;
00172 char *path = NULL;
00173 CONST char **argv;
00174 Tcl_Obj **objv = NULL;
00175 Tcl_Obj *listobjPtr = NULL;
00176 int err = 0;
00177
00178 if (pathPtr != NULL)
00179 {
00180 path = Tcl_GetString (pathPtr);
00181 if (path != NULL)
00182 {
00183 Tcl_SplitPath (path, &argc, &argv);
00184 if (argv != NULL)
00185 {
00186 objv = calloc (argc, sizeof (Tcl_Obj *));
00187 if (objv != NULL)
00188 {
00189 for (objc = 0; (!err && (objc < argc)); objc++)
00190 {
00191 objv[objc] = Tcl_NewStringObj (argv[objc], -1);
00192 err = (objv[objc] == NULL);
00193 }
00194 if (!err)
00195 {
00196 listobjPtr = Tcl_NewListObj (objc, objv);
00197 err = (listobjPtr == NULL);
00198 }
00199 if (err)
00200 {
00201 while ((--objc) > 0)
00202 Tcl_DecrRefCount (objv[objc]);
00203 }
00204 else if (lenPtr != NULL)
00205 *lenPtr = objc;
00206 free (objv);
00207 }
00208 Tcl_Free ((char *) argv);
00209 }
00210 }
00211 }
00212 return listobjPtr;
00213 }
00214
00225 static Tcl_Obj *
00226 Tcl_FSJoinPath (Tcl_Obj * listObj, int elements)
00227 {
00228 int objc, argc, lolen;
00229 char **argv;
00230 Tcl_DString theresult;
00231 Tcl_Obj *elemobj = NULL;
00232 Tcl_Obj *pathobj = NULL;
00233 int err = TCL_OK;
00234
00235 if ((listObj == NULL) || (global_interpreter == NULL)
00236 || (Tcl_ListObjLength (global_interpreter, listObj, &lolen) != TCL_OK))
00237 return NULL;
00238 argc = ((elements < 0) || (elements > lolen)) ? lolen : elements;
00239 if (argc > 0)
00240 {
00241 argv = calloc (argc, sizeof (char *));
00242 if (argv != NULL)
00243 {
00244 Tcl_DStringInit (&theresult);
00245 for (objc = 0;((err == TCL_OK) && (objc < argc)); objc++)
00246 {
00247 err = Tcl_ListObjIndex (global_interpreter, listObj, objc, &elemobj);
00248 if (err == TCL_OK)
00249 argv[objc] = Tcl_GetString (elemobj);
00250 }
00251 if (err == TCL_OK)
00252 pathobj = Tcl_NewStringObj (Tcl_JoinPath (argc, argv, &theresult), -1);
00253 Tcl_DStringFree (&theresult);
00254 }
00255 free (argv);
00256 }
00257 return pathobj;
00258 }
00259
00270 Tcl_Obj *
00271 Tcl_FSJoinToPath(Tcl_Obj * basePtr, int objc, Tcl_Obj * CONST objv[])
00272 {
00273 int i, argc;
00274 char **argv;
00275 Tcl_DString theresult;
00276 Tcl_Obj *pathobj = NULL;
00277 Tcl_Obj **segobj = NULL;
00278 int err = TCL_OK;
00279
00280 if ((objc <= 0) || (objv == NULL))
00281 pathobj = basePtr;
00282 else
00283 {
00284 argc = (basePtr == NULL) ? objc : objc + 1;
00285 argv = calloc (argc, sizeof (char *));
00286 if (argv != NULL)
00287 {
00288 i = 0;
00289 if (basePtr != NULL)
00290 argv[i++] = Tcl_GetString (basePtr);
00291 segobj = objv;
00292 while ((i < argc) && (segobj != NULL))
00293 argv[i++] = Tcl_GetString (*segobj++);
00294 Tcl_DStringInit (&theresult);
00295 pathobj = Tcl_NewStringObj (Tcl_JoinPath (i, argv, &theresult), -1);
00296 Tcl_DStringFree (&theresult);
00297 free (argv);
00298 }
00299 }
00300 return pathobj;
00301 }
00302
00303 #endif
00304
00314 void
00315 tclsadie_demolish_hashtable (ClientData clientData)
00316 {
00317 dispose_doclist ((sad_doclistp_t) clientData);
00318 }
00319
00326 static void
00327 usage (const char progname[])
00328 {
00329 printf ("TclSadie, a Tcl/Tk front end to the SADIE image processing library.\n");
00330 printf ("Usage: %s [OPTION]\n", progname);
00331 printf ("\n");
00332 printf (" -h display this help and exit\n");
00333 printf (" -v display the short version number and exit\n");
00334 printf (" -V display the verbose version information and exit\n");
00335 printf (" -d tclSadie_library_directory_path\n");
00336 printf ("\n");
00337 #if HAVE_CONFIG_H
00338
00339 printf ("Report bugs to <%s>.\n", PACKAGE_BUGREPORT);
00340 #endif
00341 }
00342
00353 static Tcl_Obj *
00354 setlibdir_env (Tcl_Interp *interp)
00355 {
00356 Tcl_Obj *tclsadie_lib = NULL;
00357 Tcl_Obj *env = NULL;
00358 Tcl_Obj *valueobjPtr = NULL;
00359
00360 env = Tcl_NewStringObj("env", -1);
00361 if (env != NULL)
00362 {
00363 Tcl_IncrRefCount (env);
00364 tclsadie_lib = Tcl_NewStringObj (lib_env_var_name, -1);
00365 if (tclsadie_lib != NULL)
00366 {
00367 Tcl_IncrRefCount (tclsadie_lib);
00368 valueobjPtr = Tcl_ObjGetVar2 (interp, env, tclsadie_lib,
00369 TCL_GLOBAL_ONLY);
00370 if (valueobjPtr)
00371 {
00372 Tcl_IncrRefCount (valueobjPtr);
00373 if ((Tcl_FSConvertToPathType (interp, valueobjPtr) != TCL_OK)
00374 || (Tcl_FSAccess (valueobjPtr, F_OK)))
00375 {
00376 Tcl_DecrRefCount (valueobjPtr);
00377 valueobjPtr = NULL;
00378 }
00379 }
00380 Tcl_DecrRefCount (tclsadie_lib);
00381 }
00382 Tcl_DecrRefCount (env);
00383 }
00384 return valueobjPtr;
00385 }
00386
00397 static Tcl_Obj *
00398 setlibdir_default (Tcl_Interp *interp)
00399 {
00400 Tcl_Obj *ourexepath = NULL;
00401 Tcl_Obj *pathlist = NULL;
00402 Tcl_Obj *dirnames[2] = { NULL, NULL };
00403 Tcl_Obj *libdirpath = NULL;
00404 int pathlen;
00405
00406 ourexepath = Tcl_NewStringObj (Tcl_GetNameOfExecutable (), -1);
00407 if (ourexepath)
00408 {
00409 Tcl_IncrRefCount (ourexepath);
00410 if (Tcl_FSConvertToPathType (interp, ourexepath) == TCL_OK)
00411 {
00412 pathlist = Tcl_FSSplitPath (ourexepath, &pathlen);
00413 if (pathlist && (pathlen >= 2))
00414 {
00415 Tcl_IncrRefCount (pathlist);
00416 dirnames[0] = Tcl_NewStringObj ("share", -1);
00417 if (dirnames[0])
00418 {
00419 Tcl_IncrRefCount (dirnames[0]);
00420 dirnames[1] = Tcl_NewStringObj (package, -1);
00421 if (dirnames[1])
00422 {
00423 Tcl_IncrRefCount (dirnames[1]);
00424 if (Tcl_ListObjReplace (interp, pathlist,
00425 (pathlen - 2), 2, 2, dirnames)
00426 == TCL_OK)
00427 {
00428 libdirpath = Tcl_FSJoinPath (pathlist, -1);
00429 if (libdirpath)
00430 {
00431 Tcl_IncrRefCount (libdirpath);
00432 if (Tcl_FSAccess (libdirpath, F_OK))
00433 {
00434 Tcl_DecrRefCount (libdirpath);
00435 libdirpath = NULL;
00436 }
00437 }
00438 }
00439 Tcl_DecrRefCount (dirnames[1]);
00440 }
00441 Tcl_DecrRefCount (dirnames[0]);
00442 }
00443 Tcl_DecrRefCount (pathlist);
00444 }
00445 }
00446 Tcl_DecrRefCount (ourexepath);
00447 }
00448 return libdirpath;
00449 }
00450
00462 static Tcl_Obj *
00463 setlibdir_build (Tcl_Interp *interp)
00464 {
00465 Tcl_Obj *ourexepath = NULL;
00466 Tcl_Obj *pathlist = NULL;
00467 Tcl_Obj *dirname = NULL;
00468 Tcl_Obj *libdirpath = NULL;
00469 int pathlen;
00470
00471 ourexepath = Tcl_NewStringObj (Tcl_GetNameOfExecutable (), -1);
00472 if (ourexepath)
00473 {
00474 Tcl_IncrRefCount (ourexepath);
00475 if (Tcl_FSConvertToPathType (interp, ourexepath) == TCL_OK)
00476 {
00477 pathlist = Tcl_FSSplitPath (ourexepath, &pathlen);
00478 if (pathlist && (pathlen >= 2))
00479 {
00480 Tcl_IncrRefCount (pathlist);
00481 dirname = Tcl_NewStringObj ("library", -1);
00482 if (dirname)
00483 {
00484 Tcl_IncrRefCount (dirname);
00485 if (Tcl_ListObjReplace (interp, pathlist,
00486 (pathlen - 2), 2, 1, &dirname)
00487 == TCL_OK)
00488 {
00489 libdirpath = Tcl_FSJoinPath (pathlist, -1);
00490 if (libdirpath)
00491 {
00492 Tcl_IncrRefCount (libdirpath);
00493 if (Tcl_FSAccess (libdirpath, F_OK))
00494 {
00495 Tcl_DecrRefCount (libdirpath);
00496 libdirpath = NULL;
00497 }
00498 }
00499 }
00500 Tcl_DecrRefCount (dirname);
00501 }
00502 Tcl_DecrRefCount (pathlist);
00503 }
00504 }
00505 Tcl_DecrRefCount (ourexepath);
00506 }
00507 return libdirpath;
00508 }
00509
00521 static int
00522 set_tclsadie_libdir (Tcl_Interp *interp, Tcl_Obj *pathObj)
00523 {
00524 Tcl_Obj *arrayobjPtr = NULL;
00525 Tcl_Obj *indexobjPtr = NULL;
00526 Tcl_Obj *libdirobjPtr = NULL;
00527 Tcl_Obj *autopathname = NULL;
00528 Tcl_Obj *autopathlist = NULL;
00529 int err = TCL_OK;
00530
00531 arrayobjPtr = Tcl_NewStringObj (sadievar_arrayname, -1);
00532 if (arrayobjPtr == NULL)
00533 err = TCL_ERROR;
00534 else
00535 {
00536 Tcl_IncrRefCount (arrayobjPtr);
00537 indexobjPtr = Tcl_NewStringObj ("libdir", -1);
00538 if (indexobjPtr == NULL)
00539 err = TCL_ERROR;
00540 else
00541 {
00542 Tcl_IncrRefCount (indexobjPtr);
00543 libdirobjPtr = Tcl_ObjSetVar2 (interp, arrayobjPtr, indexobjPtr,
00544 pathObj,
00545 TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
00546 if (libdirobjPtr == NULL)
00547 err = TCL_ERROR;
00548 else
00549 {
00550 Tcl_IncrRefCount (libdirobjPtr);
00551 autopathname = Tcl_NewStringObj ("auto_path", -1);
00552 if (autopathname == NULL)
00553 err = TCL_ERROR;
00554 else
00555 {
00556 Tcl_IncrRefCount (autopathname);
00557 autopathlist = Tcl_ObjGetVar2 (interp, autopathname, NULL,
00558 (TCL_GLOBAL_ONLY
00559 | TCL_LEAVE_ERR_MSG));
00560 if (autopathlist == NULL)
00561 err = TCL_ERROR;
00562 else
00563 {
00564 if (Tcl_IsShared (autopathlist))
00565 autopathlist = Tcl_DuplicateObj (autopathlist);
00566 err = Tcl_ListObjAppendElement (interp, autopathlist,
00567 libdirobjPtr);
00568 }
00569 Tcl_DecrRefCount (autopathname);
00570 }
00571 Tcl_DecrRefCount (libdirobjPtr);
00572 }
00573 Tcl_DecrRefCount (indexobjPtr);
00574 }
00575 Tcl_DecrRefCount (arrayobjPtr);
00576 }
00577 return err;
00578 }
00579
00592 static int
00593 setlibdir (Tcl_Interp *interp)
00594 {
00595 Tcl_Obj *basePtr = NULL;
00596 Tcl_Obj *fileobjPtr = NULL;
00597 Tcl_Obj *testobjPtr = NULL;
00598 int err = TCL_OK;
00599
00600 if (libdirpath)
00601 basePtr = Tcl_NewStringObj (libdirpath, -1);
00602 else
00603 {
00604 basePtr = setlibdir_env (interp);
00605 if (basePtr == NULL)
00606 basePtr = setlibdir_build (interp);
00607 if (basePtr == NULL)
00608 basePtr = setlibdir_default (interp);
00609 }
00610 if (basePtr == NULL)
00611 err = TCL_ERROR;
00612 else
00613 {
00614 fileobjPtr = Tcl_NewStringObj (main_file_name, -1);
00615 if (fileobjPtr == NULL)
00616 err = TCL_ERROR;
00617 else
00618 {
00619 Tcl_IncrRefCount (fileobjPtr);
00620 testobjPtr = Tcl_FSJoinToPath (basePtr, 1, &fileobjPtr);
00621 if (testobjPtr == NULL)
00622 err = TCL_ERROR;
00623 else
00624 {
00625 Tcl_IncrRefCount (testobjPtr);
00626 err = (Tcl_FSAccess (testobjPtr, R_OK) == 0)
00627 ? set_tclsadie_libdir (interp, basePtr)
00628 : TCL_ERROR;
00629 Tcl_DecrRefCount (testobjPtr);
00630 }
00631 Tcl_DecrRefCount (fileobjPtr);
00632 }
00633 Tcl_DecrRefCount (basePtr);
00634 }
00635 return err;
00636 }
00637
00648 static int
00649 set_tclsadie_version (Tcl_Interp *interp)
00650 {
00651 Tcl_Obj *arrayobjPtr = NULL;
00652 Tcl_Obj *indexobjPtr = NULL;
00653 Tcl_Obj *pnameobjPtr = NULL;
00654 int err = TCL_OK;
00655
00656 arrayobjPtr = Tcl_NewStringObj (sadievar_arrayname, -1);
00657 if (arrayobjPtr == NULL)
00658 err = TCL_ERROR;
00659 else
00660 {
00661 Tcl_IncrRefCount (arrayobjPtr);
00662 indexobjPtr = Tcl_NewStringObj ("version", -1);
00663 if (indexobjPtr == NULL)
00664 err = TCL_ERROR;
00665 else
00666 {
00667 Tcl_IncrRefCount (indexobjPtr);
00668 pnameobjPtr = Tcl_NewStringObj (short_version, -1);
00669 if (pnameobjPtr == NULL)
00670 err = TCL_ERROR;
00671 else
00672 {
00673 Tcl_IncrRefCount (pnameobjPtr);
00674 if (Tcl_ObjSetVar2 (interp, arrayobjPtr, indexobjPtr,
00675 pnameobjPtr, (TCL_GLOBAL_ONLY
00676 | TCL_LEAVE_ERR_MSG))
00677 == NULL)
00678 err = TCL_ERROR;
00679 Tcl_DecrRefCount (pnameobjPtr);
00680 }
00681 Tcl_DecrRefCount (indexobjPtr);
00682 }
00683 Tcl_DecrRefCount (arrayobjPtr);
00684 }
00685 return err;
00686 }
00687
00703 int
00704 Tcl_AppInit (Tcl_Interp *interp)
00705 {
00706 if ((Tcl_Init (interp) != TCL_OK)
00707 || (Tk_Init (interp) != TCL_OK)
00708 || (tclsadie_private_data_init (interp) != TCL_OK)
00709 || (tclsadie_app_init () != TCL_OK))
00710 return TCL_ERROR;
00711 #if (TCL_MAJOR_VERSION < 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION <= 3))
00712 global_interpreter = interp;
00713 #endif
00714
00715 global_doclist = make_doclist (6);
00716 Tcl_CreateExitHandler (tclsadie_demolish_hashtable,
00717 (ClientData) global_doclist);
00718 Application = APP_TCLSADIE;
00719 NAMES = ON;
00720 INIT ();
00721
00722 if ((Sadie_FileIO_Init (interp) != TCL_OK)
00723 || (Sadie_General_Init (interp) != TCL_OK)
00724 || (Sadie_Plot_Init (interp) != TCL_OK)
00725 || (Sadie_NewFunctions_Init (interp) != TCL_OK)
00726 || (Sadie_Contrast_Init (interp) != TCL_OK)
00727 || (Sadie_Filter_Init (interp) != TCL_OK)
00728 || (Sadie_Geometry_Init (interp) != TCL_OK)
00729 || (Sadie_Multi_Init (interp) != TCL_OK)
00730 || (Sadie_Classify_Init (interp) != TCL_OK)
00731 || (Sadie_Tools_Init (interp) != TCL_OK)
00732 || (Sadie_Image_Init (interp) != TCL_OK)
00733 || (set_tclsadie_version (interp) != TCL_OK))
00734 return TCL_ERROR;
00735
00736 if (setlibdir (interp) == TCL_OK)
00737 {
00738
00739 if (Tcl_Eval (interp, "tclSadie_main_init") != TCL_OK)
00740 return TCL_ERROR;
00741 Tk_MainLoop ();
00742 }
00743 else
00744 {
00745 fprintf (stderr,
00746 "Could not find the directory holding tclSadie's .tcl files;\n");
00747 fprintf (stderr,
00748 " you can specify the path to this with the -d command line option,\n");
00749 fprintf (stderr,
00750 " or with the %s environment variable.\n", lib_env_var_name);
00751 Tcl_Exit (1);
00752 }
00753 return TCL_OK;
00754 }
00755
00767 int
00768 main (int argc, char *argv[])
00769 {
00770 int optc;
00771 char *progname = NULL;
00772 extern char *optarg;
00773 extern int optind;
00774 extern int optopt;
00775 int err = 0;
00776 int h_flag = 0;
00777 int v_flag = 0;
00778 int V_flag = 0;
00779
00780 progname = argv[0];
00781 while ((optc = getopt (argc, argv, ":hd:vV")) != -1)
00782 {
00783 switch (optc)
00784 {
00785 case 'h':
00786 h_flag = 1;
00787 break;
00788 case 'd':
00789 libdirpath = optarg;
00790 break;
00791 case 'v':
00792 v_flag = 1;
00793 break;
00794 case 'V':
00795 V_flag = 1;
00796 break;
00797 case ':':
00798 fprintf (stderr,
00799 "%s: a path must follow the option -%c.\n",
00800 progname, optopt);
00801 err = 1;
00802 break;
00803 case '?':
00804 fprintf (stderr,
00805 "%s: could not recognize the option -%c.\n",
00806 progname, optopt);
00807 err = 1;
00808 }
00809 }
00810 if (optind < argc)
00811 {
00812 fprintf (stderr, "%s: too many arguments.\n", progname);
00813 err = 1;
00814 }
00815 if (err)
00816 {
00817 fprintf (stderr, "Try `%s -h' for more information.\n", progname);
00818 exit (2);
00819 }
00820 if (h_flag)
00821 {
00822 usage (progname);
00823 exit (0);
00824 }
00825 if (v_flag || V_flag)
00826 {
00827 printf ("%s\n", short_version);
00828 if (V_flag)
00829 printf ("%s\n", verbose_version);
00830 printf ("Copyright (C) 1988--2004 University of Arizona Digital Image Analysis Lab.\n");
00831 exit (0);
00832 }
00833
00834 printf ("Initializing tclSadie, please wait . . . . .\n");
00835 Tk_Main (1, argv, Tcl_AppInit);
00836 return 0;
00837 }