diff --git a/tcltk/magicdnull.c b/tcltk/magicdnull.c index b75531b2..f33ce851 100644 --- a/tcltk/magicdnull.c +++ b/tcltk/magicdnull.c @@ -11,6 +11,8 @@ #include +#include "tcltk/tcldir.h" + /*----------------------------------------------------------------------*/ /* Application initiation. This is exactly like the AppInit routine */ /* for "wish", minus the cruft, but with "tcl_rcFileName" set to */ @@ -29,7 +31,13 @@ magic_AppInit(interp) /* This is where we replace the home ".tclshrc" file with */ /* magic's startup script. */ - Tcl_SetVar(interp, "tcl_rcFileName", TCL_DIR "/magic.tcl", TCL_GLOBAL_ONLY); + { + char rc[PATH_MAX]; + size_t rlen; + rlen = MagicTclDir(rc, sizeof(rc), "magic.tcl"); + assert(rlen < sizeof(rc)); + Tcl_SetVar(interp, "tcl_rcFileName", rc, TCL_GLOBAL_ONLY); + } /* Additional variable can be used to tell if magic is in batch mode */ Tcl_SetVar(interp, "batch_mode", "true", TCL_GLOBAL_ONLY); diff --git a/tcltk/magicexec.c b/tcltk/magicexec.c index 73abbd3a..1a88646e 100644 --- a/tcltk/magicexec.c +++ b/tcltk/magicexec.c @@ -37,6 +37,8 @@ #include #include +#include "tcltk/tcldir.h" + /*----------------------------------------------------------------------*/ /* Application initiation. This is exactly like the AppInit routine */ /* for "wish", minus the cruft, but with "tcl_rcFileName" set to */ @@ -59,7 +61,13 @@ magic_AppInit(interp) /* This is where we replace the home ".wishrc" file with */ /* magic's startup script. */ - Tcl_SetVar(interp, "tcl_rcFileName", TCL_DIR "/magic.tcl", TCL_GLOBAL_ONLY); + { + char rc[PATH_MAX]; + size_t rlen; + rlen = MagicTclDir(rc, sizeof(rc), "magic.tcl"); + assert(rlen < sizeof(rc)); + Tcl_SetVar(interp, "tcl_rcFileName", rc, TCL_GLOBAL_ONLY); + } return TCL_OK; } diff --git a/tcltk/tcldir.h b/tcltk/tcldir.h new file mode 100644 index 00000000..0300c110 --- /dev/null +++ b/tcltk/tcldir.h @@ -0,0 +1,63 @@ +/* + * tcldir.h -- + * + * Resolve magic's Tcl-runtime directory (where magic.tcl, tclmagic.so, and the + * Tcl auto_path packages live) at *run time* instead of hardwiring the + * compile-time install path. + * + * If the environment variable CAD_ROOT is set and non-empty, use + * $CAD_ROOT/magic/tcl -- so magic runs from a relocated install, or straight out + * of a build tree (via a staged CAD_ROOT), the same way the sys files already + * follow CAD_ROOT and the tcltk/magic.sh wrapper already computes + * TCL_MAG_DIR=${CAD_ROOT}/magic/tcl. Otherwise fall back to the compile-time + * TCL_DIR (the default install location). + * + * Must be included in a translation unit compiled with -DTCL_DIR. + */ + +#ifndef _MAGIC_TCLDIR_H +#define _MAGIC_TCLDIR_H + +#include +#include +#include +#include + +/* Platform path-length limit. declares PATH_MAX when the system has + * a fixed limit (4096 on Linux); provide a safe fallback when it does not. */ +#ifndef PATH_MAX +#define PATH_MAX 4096 +#endif + +/* + * Write magic's Tcl-runtime directory into buf (of the given size), with the + * optional suffix appended as a path component -- the '/' directory separator is + * supplied automatically, so pass "magic.tcl", not "/magic.tcl" (a NULL or empty + * suffix appends nothing). A caller that wants "/magic.tcl" thus gets it in + * one call instead of a second snprintf. Return the number of characters written + * -- snprintf semantics, as a size_t -- or 0 on a (very unlikely) snprintf + * encoding error. The assert catches truncation: snprintf returns the length it + * *would* have written, so a return of >= size means the path did not fit. + * Callers should likewise assert the returned length < their buffer size. + */ +static inline size_t +MagicTclDir(char *buf, size_t size, const char *suffix) +{ + const char *cad = getenv("CAD_ROOT"); + const char *sep; + int n; + + if (suffix == NULL) suffix = ""; + sep = (*suffix != '\0') ? "/" : ""; /* imply the '/' separator */ + + if (cad != NULL && *cad != '\0') + n = snprintf(buf, size, "%s/magic/tcl%s%s", cad, sep, suffix); + else + n = snprintf(buf, size, "%s%s%s", TCL_DIR, sep, suffix); + + if (n < 0) n = 0; /* coerce encoding error to 0, assert below */ + assert((size_t)n < size); + return (size_t)n; +} + +#endif /* _MAGIC_TCLDIR_H */ diff --git a/tcltk/tclmagic.c b/tcltk/tclmagic.c index 1c007ce1..d74978d2 100644 --- a/tcltk/tclmagic.c +++ b/tcltk/tclmagic.c @@ -30,6 +30,7 @@ #endif #include "tcltk/tclmagic.h" +#include "tcltk/tcldir.h" #include "utils/main.h" #include "utils/magic.h" #include "utils/geometry.h" @@ -1528,7 +1529,15 @@ Tclmagic_Init(interp) /* Add the magic TCL directory to the Tcl library search path */ - Tcl_Eval(interp, "lappend auto_path " TCL_DIR ); + { + char dir[PATH_MAX], cmd[PATH_MAX]; + size_t dlen, clen; + dlen = MagicTclDir(dir, sizeof(dir), NULL); + assert(dlen < sizeof(dir)); + clen = snprintf(cmd, sizeof(cmd), "lappend auto_path {%s}", dir); + assert(clen < sizeof(cmd)); + Tcl_Eval(interp, cmd); + } /* Get $CAD_ROOT from a Tcl variable, if it exists, and if not, then */ /* set CAD_ROOT from the environment variable of the same name, if */