Testing remrt and rtwizard in a Windows context, more fixes popped out. A few other Windows adjustments.

db/to_g.cmake.in

@@ -22,6 +22,8 @@ file(MAKE_DIRECTORY "${LIBRT_CACHE}")
 get_filename_component(CEDIR "${CONV_EXEC}" DIRECTORY)
 set(BIN_DIR "@BIN_DIR@")
 string(REGEX REPLACE "${BIN_DIR}$" "" CROOT "${CEDIR}")
+file(TO_CMAKE_PATH "${CROOT}" CROOT)
+string(REGEX REPLACE "/$" "" CROOT "${CROOT}")
 set(ENV{BRLCAD_ROOT} "${CROOT}")
 
 # Now that we know the root, finalize the full path output file location and

include/tclcad/setup.h

@@ -50,6 +50,12 @@ TCLCAD_EXPORT extern void tclcad_bn_setup(Tcl_Interp *interp);
  * "load /usr/brlcad/lib/librt.so"
  */
 TCLCAD_EXPORT extern int Rt_Init(Tcl_Interp *interp);
+TCLCAD_EXPORT extern int Bu_Init(Tcl_Interp *interp);
+TCLCAD_EXPORT extern int Bn_Init(Tcl_Interp *interp);
+TCLCAD_EXPORT extern int Dm_Init(Tcl_Interp *interp);
+TCLCAD_EXPORT extern int Dmo_Init(Tcl_Interp *interp);
+TCLCAD_EXPORT extern int Fbo_Init(Tcl_Interp *interp);
+TCLCAD_EXPORT extern int Ged_Init(Tcl_Interp *interp);
 
 
 /* defined in cmdhist_obj.c */

regress/remrt/regress_remrt.cpp

@@ -397,6 +397,21 @@ run_ipc_subtest(const TestOptions &opts,
     std::thread stderr_read_thr(read_remrt_stderr, remrt_proc,
 				&det, &remrt_stderr_log);
 
+    /* If using -M, pipe the view script to remrt's stdin immediately.
+     * remrt reads it after startup reaches eat_script(); writing it now
+     * avoids a parent/child ordering dependency on any diagnostic banner
+     * arriving first through stderr. */
+    if (use_script) {
+	FILE *fin = bu_process_file_open(remrt_proc, BU_PROCESS_STDIN);
+	if (fin) {
+	    fputs(M35_SCRIPT, fin);
+	    bu_process_file_close(remrt_proc, BU_PROCESS_STDIN);
+	} else {
+	    fprintf(stderr, "regress_remrt [%s]: cannot open remrt stdin\n",
+		    label);
+	}
+    }
+
     {
 	std::unique_lock<std::mutex> lk(det.mtx);
 	bool ok = det.cv.wait_for(lk,
@@ -409,19 +424,6 @@ run_ipc_subtest(const TestOptions &opts,
 		    label, remrt_stderr_log.c_str());
     }
 
-    /* If using -M, pipe the view script to remrt's stdin now that remrt
-     * has started.  This unblocks eat_script() so do_work() can begin.   */
-    if (use_script) {
-	FILE *fin = bu_process_file_open(remrt_proc, BU_PROCESS_STDIN);
-	if (fin) {
-	    fputs(M35_SCRIPT, fin);
-	    bu_process_file_close(remrt_proc, BU_PROCESS_STDIN);
-	} else {
-	    fprintf(stderr, "regress_remrt [%s]: cannot open remrt stdin\n",
-		    label);
-	}
-    }
-
     /* Wait for remrt to complete the render and exit. */
     int remrt_status = bu_process_wait_n(&remrt_proc,
 					 REMRT_WAIT_SEC * 1000000 /* us */);

src/conv/asc/asc2g.c

@@ -1580,7 +1580,6 @@ main(int argc, char *argv[])
     if (!bu_vls_strncmp(&line, &str_title, 5) || !bu_vls_strncmp(&line, &str_put, 4)) {
 	Tcl_Interp *interp;
 	Tcl_Interp *safe_interp;
-	struct bu_vls msg = BU_VLS_INIT_ZERO;
 	int tret = 0;
 
 	/* this is a Tcl script */
@@ -1589,11 +1588,13 @@ main(int argc, char *argv[])
 	bu_vls_trunc(&line, 0);
 
 	interp = Tcl_CreateInterp();
-	tret = tclcad_init(interp, 0, &msg);
+	tret = Ged_Init(interp);
 	if (tret == TCL_ERROR) {
-	    bu_log("tclcad_init error: %s\n", bu_vls_cstr(&msg));
+	    bu_log("Ged_Init error: %s\n", Tcl_GetStringResult(interp));
+	    fclose(ifp);
+	    db_close(ofp->dbip);
+	    Tcl_Exit(1);
 	}
-	bu_vls_free(&msg);
 	db_close(ofp->dbip);
 
 	{

src/libbg/geogram/basic/geometry_nd.h

@@ -410,10 +410,14 @@ namespace GEOBRL {
         ) {
             double l2 = distance2(V0,V1);
             double t = dot(point - V0, V1 - V0);
+#if defined(__GNUC__) && !defined(__clang__)
 #pragma GCC diagnostic push
 #pragma GCC diagnostic ignored "-Wfloat-equal"
+#endif
             if(t <= 0.0 || l2 == 0.0) {
+#if defined(__GNUC__) && !defined(__clang__)
 #pragma GCC diagnostic pop
+#endif
                 closest_point = V0;
                 lambda0 = 1.0;
                 lambda1 = 0.0;

src/libtclcad/bn.c

@@ -1356,7 +1356,7 @@ tclcad_bn_setup(Tcl_Interp *interp)
 }
 
 
-int
+TCLCAD_EXPORT int
 Bn_Init(Tcl_Interp *interp)
 {
     tclcad_bn_setup(interp);

src/libtclcad/bu.c

@@ -394,7 +394,7 @@ register_cmds(Tcl_Interp *interp, struct bu_cmdtab *cmds)
 }
 
 
-int
+TCLCAD_EXPORT int
 Bu_Init(Tcl_Interp *interp)
 {
     static struct bu_cmdtab cmds[] = {

src/libtclcad/commands.c

@@ -955,7 +955,7 @@ struct to_cmdtab to_cmds[] = {
  * @brief create the Tcl command for to_open
  *
  */
-int
+TCLCAD_EXPORT int
 Ged_Init(Tcl_Interp *interp)
 {
 

src/libtclcad/dm.c

@@ -2771,7 +2771,7 @@ dmo_open_tcl(ClientData UNUSED(clientData), Tcl_Interp *interp, int argc, char *
 }
 
 
-int
+TCLCAD_EXPORT int
 Dmo_Init(Tcl_Interp *interp)
 {
     BU_LIST_INIT(&HeadDMObj.l);
@@ -2892,7 +2892,7 @@ register_cmds(Tcl_Interp *interp, struct bu_cmdtab *cmds)
 }
 
 
-int
+TCLCAD_EXPORT int
 Dm_Init(Tcl_Interp *interp)
 {
     static struct bu_cmdtab cmdtab[] = {

src/libtclcad/fb.c

@@ -930,7 +930,7 @@ fbo_open_tcl(void *UNUSED(clientData), Tcl_Interp *interp, int argc, const char
 }
 
 
-int
+TCLCAD_EXPORT int
 Fbo_Init(Tcl_Interp *interp)
 {
     if (fb_objs.capacity == 0) {

src/libtclcad/init.c

@@ -36,6 +36,7 @@
 #include "vmath.h"
 #include "bu/app.h"
 #include "bu/cmd.h"
+#include "bu/env.h"
 #include "bu/path.h"
 #include "bu/vls.h"
 #include "bn.h"
@@ -78,6 +79,23 @@ tclcad_register_cmds(Tcl_Interp *interp, struct bu_cmdtab *cmds)
     }
 }
 
+static int
+tclcad_source_file(Tcl_Interp *interp, const char *filename)
+{
+    Tcl_Obj *cmd[2] = {NULL, NULL};
+    int ret = TCL_ERROR;
+
+    cmd[0] = Tcl_NewStringObj("source", -1);
+    cmd[1] = Tcl_NewStringObj(filename, -1);
+    Tcl_IncrRefCount(cmd[0]);
+    Tcl_IncrRefCount(cmd[1]);
+    ret = Tcl_EvalObjv(interp, 2, cmd, TCL_EVAL_GLOBAL);
+    Tcl_DecrRefCount(cmd[1]);
+    Tcl_DecrRefCount(cmd[0]);
+
+    return ret;
+}
+
 
 /* avoid including itcl.h/itk.h due to their usage of internal headers */
 extern int Itcl_Init(Tcl_Interp *);
@@ -95,27 +113,49 @@ tclcad_init(Tcl_Interp *interp, int init_gui, struct bu_vls *tlog)
      * if we can.  Per the Tcl_Init() definition in generic/tclInterp.c in the
      * Tcl source code, setting tcl_library is the recommended way for embedding
      * applications to assist Tcl_Init in finding this file... */
+    char initfile[MAXPATHLEN] = {0};
     char libdir[MAXPATHLEN] = {0};
     bu_dir(libdir, MAXPATHLEN, BU_DIR_LIB, NULL);
     if (strlen(libdir)) {
-	struct bu_vls lib_path = BU_VLS_INIT_ZERO;
-	bu_vls_sprintf(&lib_path, "%s%ctcl%s/init.tcl", libdir, BU_DIR_SEPARATOR, TCL_VERSION);
-	if (bu_file_exists(bu_vls_cstr(&lib_path), NULL)) {
-	    struct bu_vls initpath = BU_VLS_INIT_ZERO;
-	    bu_vls_sprintf(&lib_path, "%s%ctcl%s", libdir, BU_DIR_SEPARATOR, TCL_VERSION);
-	    bu_vls_printf(&initpath, "set tcl_library {%s}", bu_vls_cstr(&lib_path));
-	    if (Tcl_Eval(interp, bu_vls_addr(&initpath))) {
-		bu_log("Problem initializing tcl_library to init.tcl path: Tcl_Eval ERROR:\n%s\n", Tcl_GetStringResult(interp));
+	char *src = libdir;
+	char *dst = libdir;
+	char prev = '\0';
+	while (*src) {
+	    char c = (*src == '\\') ? '/' : *src;
+	    if (c != '/' || prev != '/') {
+		*dst++ = c;
 	    }
-	    bu_vls_free(&initpath);
+	    prev = c;
+	    src++;
+	}
+	*dst = '\0';
+
+	struct bu_vls lib_path = BU_VLS_INIT_ZERO;
+	bu_vls_sprintf(&lib_path, "%s/tcl%s/init.tcl", libdir, TCL_VERSION);
+	if (bu_file_exists(bu_vls_cstr(&lib_path), NULL)) {
+	    snprintf(initfile, MAXPATHLEN, "%s", bu_vls_cstr(&lib_path));
+	    bu_vls_sprintf(&lib_path, "%s/tcl%s", libdir, TCL_VERSION);
+	    bu_setenv("TCL_LIBRARY", bu_vls_cstr(&lib_path), 1);
+	    (void)Tcl_SetVar(interp, "tcl_library", bu_vls_cstr(&lib_path), TCL_GLOBAL_ONLY);
+	    (void)Tcl_SetVar2(interp, "env", "TCL_LIBRARY", bu_vls_cstr(&lib_path), TCL_GLOBAL_ONLY);
 	}
 	bu_vls_free(&lib_path);
     }
 
     if (Tcl_Init(interp) == TCL_ERROR) {
-	if (tlog)
-	    bu_vls_printf(tlog, "Tcl init ERROR:\n%s\n", Tcl_GetStringResult(interp));
-	return TCL_ERROR;
+	struct bu_vls tcl_init_error = BU_VLS_INIT_ZERO;
+	bu_vls_sprintf(&tcl_init_error, "%s", Tcl_GetStringResult(interp));
+	Tcl_ResetResult(interp);
+	if (!strlen(initfile) || tclcad_source_file(interp, initfile) == TCL_ERROR) {
+	    if (tlog) {
+		bu_vls_printf(tlog, "Tcl init ERROR:\n%s\n", Tcl_GetStringResult(interp));
+		if (bu_vls_strlen(&tcl_init_error))
+		    bu_vls_printf(tlog, "\nOriginal Tcl_Init ERROR:\n%s\n", bu_vls_cstr(&tcl_init_error));
+	    }
+	    bu_vls_free(&tcl_init_error);
+	    return TCL_ERROR;
+	}
+	bu_vls_free(&tcl_init_error);
     }
 
     if (init_gui) {

src/libtclcad/tclcad_private.h

@@ -77,12 +77,12 @@ extern int tclcad_eval_noresult(Tcl_Interp *interp, const char *command, size_t
 
 
 /* Tcl initialization routines */
-extern int Bu_Init(Tcl_Interp *interp);
-extern int Bn_Init(Tcl_Interp *interp);
-extern int Dm_Init(Tcl_Interp *interp);
-extern int Dmo_Init(Tcl_Interp *interp);
-extern int Fbo_Init(Tcl_Interp *interp);
-extern int Ged_Init(Tcl_Interp *interp);
+TCLCAD_EXPORT extern int Bu_Init(Tcl_Interp *interp);
+TCLCAD_EXPORT extern int Bn_Init(Tcl_Interp *interp);
+TCLCAD_EXPORT extern int Dm_Init(Tcl_Interp *interp);
+TCLCAD_EXPORT extern int Dmo_Init(Tcl_Interp *interp);
+TCLCAD_EXPORT extern int Fbo_Init(Tcl_Interp *interp);
+TCLCAD_EXPORT extern int Ged_Init(Tcl_Interp *interp);
 
 /* Fb functions */
 extern int to_close_fbs(struct bview *gdvp);
@@ -475,7 +475,7 @@ extern void
 tclcad_open_client_handler(struct fbserv_obj *fbsp, int i, void *data);
 extern void
 tclcad_close_client_handler(struct fbserv_obj *fbsp, int sub);
-extern int
+TCLCAD_EXPORT extern int
 tclcad_listen_ipc(struct fbserv_obj *fbsp, Tcl_Interp *interp);
 
 __END_DECLS

src/remrt/remrt.c

@@ -4043,6 +4043,13 @@ main(int argc, char *argv[])
 
     bu_setprogname(argv[0]);
 
+#if defined(_WIN32) && !defined(__CYGWIN__)
+    {
+	WSADATA wsaData;
+	(void)WSAStartup(MAKEWORD(2, 2), &wsaData);
+    }
+#endif
+
 #ifdef SIGPIPE
     /* Ignore SIGPIPE early so that a closed pipe in the test harness (or any
      * other caller that closes remrt's stdout/stderr read ends) does not kill

src/rtwizard/main.c

@@ -28,6 +28,15 @@
 #  include <direct.h> /* For chdir */
 #endif
 
+#if defined(_WIN32) && !defined(__CYGWIN__)
+__declspec(dllimport) void * __stdcall GetStdHandle(unsigned long);
+__declspec(dllimport) int __stdcall SetHandleInformation(void *, unsigned long, unsigned long);
+#  define RTWIZARD_STD_INPUT_HANDLE  ((unsigned long)-10)
+#  define RTWIZARD_STD_OUTPUT_HANDLE ((unsigned long)-11)
+#  define RTWIZARD_STD_ERROR_HANDLE  ((unsigned long)-12)
+#  define RTWIZARD_HANDLE_FLAG_INHERIT 0x00000001UL
+#endif
+
 #include "tcl.h"
 
 #include "vmath.h"
@@ -648,10 +657,53 @@ int rtwizard_imgformat_supported(int fmt) {
 }
 
 
+#if defined(_WIN32) && !defined(__CYGWIN__)
+static void
+rtwizard_disable_std_handle_inheritance(void)
+{
+    void *h = NULL;
+
+    h = GetStdHandle(RTWIZARD_STD_INPUT_HANDLE);
+    if (h)
+	(void)SetHandleInformation(h, RTWIZARD_HANDLE_FLAG_INHERIT, 0);
+
+    h = GetStdHandle(RTWIZARD_STD_OUTPUT_HANDLE);
+    if (h)
+	(void)SetHandleInformation(h, RTWIZARD_HANDLE_FLAG_INHERIT, 0);
+
+    h = GetStdHandle(RTWIZARD_STD_ERROR_HANDLE);
+    if (h)
+	(void)SetHandleInformation(h, RTWIZARD_HANDLE_FLAG_INHERIT, 0);
+}
+#endif
+
+
+static void
+rtwizard_set_state(Tcl_Interp *interp, const char *key, const char *value)
+{
+    (void)Tcl_SetVar2(interp, "::RtWizard::wizard_state", key, value, TCL_GLOBAL_ONLY);
+}
+
+
+static void
+rtwizard_set_state_ptbl(Tcl_Interp *interp, const char *key, struct bu_ptbl *ptbl)
+{
+    size_t i = 0;
+    Tcl_Obj *obj = Tcl_NewListObj(0, NULL);
+
+    Tcl_IncrRefCount(obj);
+    for (i = 0; i < BU_PTBL_LEN(ptbl); i++) {
+	const char *item = (const char *)BU_PTBL_GET(ptbl, i);
+	(void)Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(item, -1));
+    }
+    (void)Tcl_SetVar2Ex(interp, "::RtWizard::wizard_state", key, obj, TCL_GLOBAL_ONLY);
+    Tcl_DecrRefCount(obj);
+}
+
+
 void
 Init_RtWizard_Vars(Tcl_Interp *interp, struct rtwizard_settings *s)
 {
-    size_t i = 0;
     struct bu_vls tcl_cmd = BU_VLS_INIT_ZERO;
 
     (void)Tcl_Eval(interp, "namespace eval RtWizard {}");
@@ -672,18 +724,15 @@ Init_RtWizard_Vars(Tcl_Interp *interp, struct rtwizard_settings *s)
     }
 
     if (bu_vls_strlen(s->input_file)) {
-	bu_vls_sprintf(&tcl_cmd, "set ::RtWizard::wizard_state(dbFile) [list %s]", bu_vls_addr(s->input_file));
-	(void)Tcl_Eval(interp, bu_vls_addr(&tcl_cmd));
+	rtwizard_set_state(interp, "dbFile", bu_vls_addr(s->input_file));
     }
 
     if (bu_vls_strlen(s->output_file)) {
-	bu_vls_sprintf(&tcl_cmd, "set ::RtWizard::wizard_state(output_filename) [list %s]", bu_vls_addr(s->output_file));
-	(void)Tcl_Eval(interp, bu_vls_addr(&tcl_cmd));
+	rtwizard_set_state(interp, "output_filename", bu_vls_addr(s->output_file));
     }
 
     if (bu_vls_strlen(s->fb_dev)) {
-	bu_vls_sprintf(&tcl_cmd, "set ::RtWizard::wizard_state(fbserv_device) %s", bu_vls_addr(s->fb_dev));
-	(void)Tcl_Eval(interp, bu_vls_addr(&tcl_cmd));
+	rtwizard_set_state(interp, "fbserv_device", bu_vls_addr(s->fb_dev));
     }
 
     if (s->port > -1) {
@@ -714,35 +763,9 @@ Init_RtWizard_Vars(Tcl_Interp *interp, struct rtwizard_settings *s)
 	}
     }
 
-    bu_vls_sprintf(&tcl_cmd, "set ::RtWizard::wizard_state(color_objlist) {}");
-    (void)Tcl_Eval(interp, bu_vls_addr(&tcl_cmd));
-    if (BU_PTBL_LEN(s->color) > 0) {
-	for (i = 0; i < BU_PTBL_LEN(s->color); i++) {
-	    const char *obj = (const char *)BU_PTBL_GET(s->color, i);
-	    bu_vls_sprintf(&tcl_cmd, "lappend ::RtWizard::wizard_state(color_objlist) %s", obj);
-	    (void)Tcl_Eval(interp, bu_vls_addr(&tcl_cmd));
-	}
-    }
-
-    bu_vls_sprintf(&tcl_cmd, "set ::RtWizard::wizard_state(ghost_objlist) {}");
-    (void)Tcl_Eval(interp, bu_vls_addr(&tcl_cmd));
-    if (BU_PTBL_LEN(s->ghost) > 0) {
-	for (i = 0; i < BU_PTBL_LEN(s->ghost); i++) {
-	    const char *obj = (const char *)BU_PTBL_GET(s->ghost, i);
-	    bu_vls_sprintf(&tcl_cmd, "lappend ::RtWizard::wizard_state(ghost_objlist) %s", obj);
-	    (void)Tcl_Eval(interp, bu_vls_addr(&tcl_cmd));
-	}
-    }
-
-    bu_vls_sprintf(&tcl_cmd, "set ::RtWizard::wizard_state(line_objlist) {}");
-    (void)Tcl_Eval(interp, bu_vls_addr(&tcl_cmd));
-    if (BU_PTBL_LEN(s->line) > 0) {
-	for (i = 0; i < BU_PTBL_LEN(s->line); i++) {
-	    const char *obj = (const char *)BU_PTBL_GET(s->line, i);
-	    bu_vls_sprintf(&tcl_cmd, "lappend ::RtWizard::wizard_state(line_objlist) %s", obj);
-	    (void)Tcl_Eval(interp, bu_vls_addr(&tcl_cmd));
-	}
-    }
+    rtwizard_set_state_ptbl(interp, "color_objlist", s->color);
+    rtwizard_set_state_ptbl(interp, "ghost_objlist", s->ghost);
+    rtwizard_set_state_ptbl(interp, "line_objlist", s->line);
 
     {
 	unsigned char rgb[3];
@@ -825,13 +848,11 @@ Init_RtWizard_Vars(Tcl_Interp *interp, struct rtwizard_settings *s)
     }
 
     if (bu_vls_strlen(s->log_file)) {
-	bu_vls_sprintf(&tcl_cmd, "set ::RtWizard::wizard_state(log_file) [list %s]", bu_vls_addr(s->log_file));
-	(void)Tcl_Eval(interp, bu_vls_addr(&tcl_cmd));
+	rtwizard_set_state(interp, "log_file", bu_vls_addr(s->log_file));
     }
 
     if (bu_vls_strlen(s->pid_file)) {
-	bu_vls_sprintf(&tcl_cmd, "set ::RtWizard::wizard_state(pid_filename) [list %s]", bu_vls_addr(s->pid_file));
-	(void)Tcl_Eval(interp, bu_vls_addr(&tcl_cmd));
+	rtwizard_set_state(interp, "pid_filename", bu_vls_addr(s->pid_file));
     }
 
 
@@ -1195,6 +1216,10 @@ main(int argc, char **argv)
 	 * because they can apparently cause problems with Tcl script execution. */
 	tclcad_set_argv(interp, 1, (const char **)&av0);
 
+#if defined(_WIN32) && !defined(__CYGWIN__)
+	rtwizard_disable_std_handle_inheritance();
+#endif
+
 	Init_RtWizard_Vars(interp, s);
 	if (s->port < 0) {
 	    (void)rtwizard_setup_ipc(interp);
@@ -1212,8 +1237,13 @@ main(int argc, char **argv)
 	Tcl_DStringFree(&temp);
 
 	result = Tcl_GetStringResult(interp);
-	if (strlen(result) > 0 && status == TCL_ERROR) {
-	    bu_log("%s\n", result);
+	if (status != TCL_OK) {
+	    const char *error_info = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
+	    bu_log("rtwizard Tcl script returned status %d\n", status);
+	    if (strlen(result) > 0)
+		bu_log("%s\n", result);
+	    if (error_info && strlen(error_info) > 0)
+		bu_log("%s\n", error_info);
 	}
 
 	/*Tcl_DeleteInterp(interp);*/

src/tclscripts/CMakeLists.txt

@@ -4,26 +4,60 @@ file(
   WRITE
   "${CMAKE_BINARY_DIR}/CMakeTmp/auto_mkindex.tcl"
   "
-foreach arg $argv {
+set arg [lindex $argv 0]
+set files [lrange $argv 1 end]
 puts \"Generating tclIndex in $arg\"
-catch {auto_mkindex $arg *.tcl *.itcl *.itk *.sh} errout
+catch {auto_mkindex $arg {*}$files} errout
 if {![file exists \"$arg/tclIndex\"]} {
 puts \"$errout\"
 return -code 1
-}
 }"
 )
 file(
   WRITE
   "${CMAKE_BINARY_DIR}/CMakeTmp/pkg_mkIndex.tcl"
   "
-foreach arg $argv {
+rename glob __brlcad_orig_glob
+proc glob {args} {
+set dpos [lsearch -exact $args -directory]
+set dash [lsearch -exact $args --]
+if {$dpos >= 0 && $dash >= 0} {
+set dir [lindex $args [expr {$dpos + 1}]]
+set patterns [lrange $args [expr {$dash + 1}] end]
+set opts [lrange $args 0 [expr {$dash - 1}]]
+set tails [expr {[lsearch -exact $opts -tails] >= 0}]
+set filtered {}
+for {set i 0} {$i < [llength $opts]} {incr i} {
+set opt [lindex $opts $i]
+if {$opt eq \"-directory\"} {
+incr i
+continue
+}
+if {$opt eq \"-tails\"} {
+continue
+}
+lappend filtered $opt
+}
+set out {}
+foreach pat $patterns {
+if {[catch {__brlcad_orig_glob {*}$filtered -- [file join $dir $pat]} matches]} {
+continue
+}
+foreach match $matches {
+lappend out [expr {$tails ? [file tail $match] : $match}]
+}
+}
+return $out
+}
+return [__brlcad_orig_glob {*}$args]
+}
+set arg [lindex $argv 0]
+set files [lrange $argv 1 end]
 puts \"Generating pkgIndex.tcl in $arg\"
-catch {pkg_mkIndex -verbose $arg *.tcl *.itcl *.itk *.sh} errout
+catch {pkg_mkIndex -verbose $arg {*}$files} errout
 if {![file exists \"$arg/pkgIndex.tcl\"]} {
 puts \"$errout\"
 return -code 1
-}
 }"
 )
 
@@ -46,11 +80,17 @@ macro(general_tcl_index_BUILD cmd outfile targetdir)
   brlcad_get_dir_list_contents(DATA_TARGETS "${CMAKE_CURRENT_BINARY_DIR}" data_target_list)
   set_property(GLOBAL APPEND PROPERTY index_cpy_targets ${data_target_list})
 
-  # We want to be out of date if any of the tcl files in the current directory
+  # We want to be out of date if any of the Tcl-ish files in the current directory
   # change, since both pkgIndex and tclIndex are going to scan the directory
-  file(GLOB tcl_files "*.tcl")
+  file(GLOB tcl_files "*.tcl" "*.itcl" "*.itk" "*.sh")
   set_property(GLOBAL APPEND PROPERTY index_depends_files ${tcl_files})
 
+  set(tclindex_file_args)
+  foreach(tcl_file ${tcl_files})
+    get_filename_component(tcl_file_name "${tcl_file}" NAME)
+    string(APPEND tclindex_file_args " \"${tcl_file_name}\"")
+  endforeach()
+
   # Command that builds the index when the dependency is resolved.  We need
   # to use btclsh here to generate files correctly for Archer, but btclsh
   # will try to read the files we are generating.  As long as they are in a
@@ -62,7 +102,7 @@ macro(general_tcl_index_BUILD cmd outfile targetdir)
   file(
     APPEND
     "${index_cmds_file}"
-    "execute_process(COMMAND \${BTCLSH} \"${CMAKE_BINARY_DIR}/CMakeTmp/${cmd}.tcl\" \"${tclindex_outdir}\" RESULT_VARIABLE BRES)\nif(BRES)\n  message(FATAL_ERROR \"Failed to process ${tclindex_outdir}\")\nendif()\n"
+    "execute_process(COMMAND \${BTCLSH} \"${CMAKE_BINARY_DIR}/CMakeTmp/${cmd}.tcl\" \"${tclindex_outdir}\"${tclindex_file_args} RESULT_VARIABLE BRES)\nif(BRES)\n  message(FATAL_ERROR \"Failed to process ${tclindex_outdir}\")\nendif()\n"
   )
 
   set_property(GLOBAL APPEND PROPERTY index_install_files ${targetdir}/${outfile})

src/tclscripts/lib/RtImage.tcl

@@ -43,6 +43,12 @@ proc ::pid_wait { pid } {
 
 namespace eval cadwidgets {
 
+proc rtimage_exec_log {cmd log_file} {
+    if {[catch {exec {*}$cmd >& $log_file} msg]} {
+	return -code error "rtimage command failed: $cmd\n$msg"
+    }
+}
+
 proc rtimage {rtimage_dict} {
     global tcl_platform
     global env
@@ -95,17 +101,20 @@ proc rtimage {rtimage_dict} {
     if {[llength $_color_objects]} {
 	set have_color_objects 1
 
-	set cmd [concat [list [file join $binpath rt]] -w $_w -n $_n $_benchmark_mode \
-	    -F $_port \
+	set cmd [list [file join $binpath rt] -w $_w -n $_n]
+	if {$_benchmark_mode != ""} {
+	    lappend cmd $_benchmark_mode
+	}
+	lappend cmd -F $_port \
 	    -V $ar \
 	    -R \
 	    -A 0.9 \
 	    -p $_perspective \
 	    -C [lindex $_bgcolor 0]/[lindex $_bgcolor 1]/[lindex $_bgcolor 2] \
-	    "-c {viewsize $_viewsize}" \
-	    "-c {orientation $_orientation}" \
-	    "-c {eye_pt $_eye_pt}" \
-	    [list $_dbfile]]
+	    -c "viewsize $_viewsize" \
+	    -c "orientation $_orientation" \
+	    -c "eye_pt $_eye_pt" \
+	    $_dbfile
 
 	foreach obj $_color_objects {
 	    lappend cmd $obj
@@ -116,7 +125,7 @@ proc rtimage {rtimage_dict} {
 	#
 	# Run rt to generate the color insert
 	#
-	catch {eval exec $cmd >& $_log_file} curr_pid
+	rtimage_exec_log $cmd $_log_file
 
 	# Look for color objects that also get edges
 	if {[llength $_edge_objects] && [llength $_ecolor] == 3} {
@@ -145,19 +154,22 @@ proc rtimage {rtimage_dict} {
 		if {[llength $ce_objects]} {
 		    set bgMode [list set bg=[lindex $_bgcolor 0],[lindex $_bgcolor 1],[lindex $_bgcolor 2]]
 
-		    set cmd [concat [list [file join $binpath rtedge]] -w $_w -n $_n $_benchmark_mode \
-		                 -F $_port \
-				 -V $ar \
-				 -R \
-				 -A 0.9 \
-				 -p $_perspective \
-				 "-c {$fgMode}" \
-				 "-c {$bgMode}" \
-				 "-c {set ov=1}" \
-				 "-c {viewsize $_viewsize}" \
-				 "-c {orientation $_orientation}" \
-				 "-c {eye_pt $_eye_pt}" \
-				 [list $_dbfile]]
+		    set cmd [list [file join $binpath rtedge] -w $_w -n $_n]
+		    if {$_benchmark_mode != ""} {
+			lappend cmd $_benchmark_mode
+		    }
+		    lappend cmd -F $_port \
+			-V $ar \
+			-R \
+			-A 0.9 \
+			-p $_perspective \
+			-c $fgMode \
+			-c $bgMode \
+			-c "set ov=1" \
+			-c "viewsize $_viewsize" \
+			-c "orientation $_orientation" \
+			-c "eye_pt $_eye_pt" \
+			$_dbfile
 
 		    foreach obj $ce_objects {
 			lappend cmd $obj
@@ -170,7 +182,7 @@ proc rtimage {rtimage_dict} {
 		#
 		# Run rtedge to generate the full-color with edges
 		#
-		catch {eval exec $cmd >& $_log_file} curr_pid
+		rtimage_exec_log $cmd $_log_file
 	    }
 	}
 
@@ -189,17 +201,20 @@ proc rtimage {rtimage_dict} {
 	catch {exec [file join $binpath fb-pix] -w $_w -n $_n -F $_port $tfci}
 
 	set have_ghost_objects 1
-	set cmd [concat [list [file join $binpath rt]] -w $_w -n $_n $_benchmark_mode \
-	             -o $tgi \
-		     -V $ar \
-		     -R \
-		     -A 0.9 \
-		     -p $_perspective \
-		     -C [lindex $_bgcolor 0]/[lindex $_bgcolor 1]/[lindex $_bgcolor 2] \
-		     "-c {viewsize $_viewsize}" \
-		     "-c {orientation $_orientation}" \
-		     "-c {eye_pt $_eye_pt}" \
-		     [list $_dbfile]]
+	set cmd [list [file join $binpath rt] -w $_w -n $_n]
+	if {$_benchmark_mode != ""} {
+	    lappend cmd $_benchmark_mode
+	}
+	lappend cmd -o $tgi \
+	    -V $ar \
+	    -R \
+	    -A 0.9 \
+	    -p $_perspective \
+	    -C [lindex $_bgcolor 0]/[lindex $_bgcolor 1]/[lindex $_bgcolor 2] \
+	    -c "viewsize $_viewsize" \
+	    -c "orientation $_orientation" \
+	    -c "eye_pt $_eye_pt" \
+	    $_dbfile
 
 	foreach obj $_ghost_objects {
 	    lappend cmd $obj
@@ -210,19 +225,22 @@ proc rtimage {rtimage_dict} {
 	#
 	# Run rt to generate the full-color version of the ghost image
 	#
-	catch {eval exec $cmd >& $_log_file} curr_pid
+	rtimage_exec_log $cmd $_log_file
 
-	set cmd [concat [list [file join $binpath rt]] -w $_w -n $_n $_benchmark_mode \
-	             -o $tgfci \
-		     -V $ar \
-		     -R \
-		     -A 0.9 \
-		     -p $_perspective \
-		     -C [lindex $_bgcolor 0]/[lindex $_bgcolor 1]/[lindex $_bgcolor 2] \
-		     "-c {viewsize $_viewsize}" \
-		     "-c {orientation $_orientation}" \
-		     "-c {eye_pt $_eye_pt}" \
-		     [list $_dbfile]]
+	set cmd [list [file join $binpath rt] -w $_w -n $_n]
+	if {$_benchmark_mode != ""} {
+	    lappend cmd $_benchmark_mode
+	}
+	lappend cmd -o $tgfci \
+	    -V $ar \
+	    -R \
+	    -A 0.9 \
+	    -p $_perspective \
+	    -C [lindex $_bgcolor 0]/[lindex $_bgcolor 1]/[lindex $_bgcolor 2] \
+	    -c "viewsize $_viewsize" \
+	    -c "orientation $_orientation" \
+	    -c "eye_pt $_eye_pt" \
+	    $_dbfile
 
 	foreach obj $occlude_objects {
 	    lappend cmd $obj
@@ -233,7 +251,7 @@ proc rtimage {rtimage_dict} {
 	#
 	# Run rt to generate the full-color version of the occlude_objects (i.e. color and ghost)
 	#
-	catch {eval exec $cmd >& $_log_file} curr_pid
+	rtimage_exec_log $cmd $_log_file
 
 	#
 	# Convert to ghost image
@@ -278,19 +296,25 @@ proc rtimage {rtimage_dict} {
 	    set bgMode [list set bg=[lindex $_bgcolor 0],[lindex $_bgcolor 1],[lindex $_bgcolor 2]]
 	}
 
-	set cmd [concat [list [file join $binpath rtedge]] -w $_w -n $_n $_benchmark_mode \
-	             -F $_port \
-		     -V $ar \
-		     -R \
-		     -A 0.9 \
-		     -p $_perspective \
-		     "-c {$fgMode}" \
-		     "-c {$bgMode}" \
-		     $coMode \
-	             "-c {viewsize $_viewsize}" \
-		     "-c {orientation $_orientation}" \
-		     "-c {eye_pt $_eye_pt}" \
-		     [list $_dbfile]]
+	set cmd [list [file join $binpath rtedge] -w $_w -n $_n]
+	if {$_benchmark_mode != ""} {
+	    lappend cmd $_benchmark_mode
+	}
+	lappend cmd -F $_port \
+	    -V $ar \
+	    -R \
+	    -A 0.9 \
+	    -p $_perspective \
+	    -c $fgMode \
+	    -c $bgMode
+	if {[llength $occlude_objects]} {
+	    lappend cmd -c "set om=$_occmode" -c "set oo=\"$occlude_objects\""
+	}
+	lappend cmd \
+	    -c "viewsize $_viewsize" \
+	    -c "orientation $_orientation" \
+	    -c "eye_pt $_eye_pt" \
+	    $_dbfile
 	foreach obj $_edge_objects {
 	    lappend cmd $obj
 	}
@@ -300,7 +324,7 @@ proc rtimage {rtimage_dict} {
 	#
 	# Run rtedge to generate the full-color version of the ghost image
 	# !!! manually write an rtedge log
-	catch {eval exec $cmd >& rtedge.log} curr_pid
+	rtimage_exec_log $cmd rtedge.log
     }
 
     catch {file delete -force $tgi}

src/tclscripts/rtwizard/rtwizard

@@ -181,10 +181,10 @@ if {[info exists ::use_gui]} {
    # Check whether the framebuffer already exists.  If it does, and if
    # it was specified on the command line, go with it.
    if {$use_ipc} {
-      if {[catch {exec {*}[rtwiz_fbserv_cmd] &} pid] == 0} {
+      if {[catch {exec {*}[rtwiz_fbserv_cmd] < NUL >> $::RtWizard::wizard_state(log_file) 2>@1 &} pid] == 0} {
 	set fbserv_pid $pid
 	set _fb_wait 0
-	while {[catch {exec [file join [bu_dir bin] fblabel] -F [rtwiz_fb_target] 1 1 " "} _fb_err] && $_fb_wait < 30} {
+	while {[catch {exec [file join [bu_dir bin] fblabel] -F [rtwiz_fb_target] 1 1 " " 2>@1} _fb_err] && $_fb_wait < 30} {
 	    after 100
 	    incr _fb_wait
 	}
@@ -196,8 +196,8 @@ if {[info exists ::use_gui]} {
 	if {$::RtWizard::wizard_state(verbose)} {puts "fbserv IPC launch failed: $pid"}
       }
    } else {
-      if { [catch {exec {*}$fbserv_token_prefix [file join [bu_dir bin] fblabel] -F [rtwiz_fb_target] 1 1 " "} error ] && $error == 12} {
-	 catch {exec {*}[rtwiz_fbserv_cmd] &} pid
+      if { [catch {exec {*}$fbserv_token_prefix [file join [bu_dir bin] fblabel] -F [rtwiz_fb_target] 1 1 " " 2>@1} error ] && $error == 12} {
+	 catch {exec {*}[rtwiz_fbserv_cmd] < NUL >> $::RtWizard::wizard_state(log_file) 2>@1 &} pid
 	 if {[info exists pid]} {
 	   set fbserv_pid $pid
 	   # Wait for fbserv to become ready.  Poll fblabel: if it fails because fbserv
@@ -205,7 +205,7 @@ if {[info exists ::use_gui]} {
 	   # Stop early if the failure reason changes to something other than connection-
 	   # refused (e.g. a token mismatch means another instance already owns the port).
 	   set _fb_wait 0
-	   while { [catch {exec {*}$fbserv_token_prefix [file join [bu_dir bin] fblabel] -F [rtwiz_fb_target] 1 1 " "} _fb_err] && $_fb_wait < 30 && [string match {*can't connect*} $_fb_err] } {
+	   while { [catch {exec {*}$fbserv_token_prefix [file join [bu_dir bin] fblabel] -F [rtwiz_fb_target] 1 1 " " 2>@1} _fb_err] && $_fb_wait < 30 && [string match {*can't connect*} $_fb_err] } {
 	       after 300
 	       incr _fb_wait
 	   }
@@ -237,7 +237,7 @@ if {[info exists ::use_gui]} {
 		if {$::RtWizard::wizard_state(verbose)} {puts "fbserv port $::RtWizard::wizard_state(fbserv_port) is already in use."}
 		incr ::RtWizard::wizard_state(fbserv_port)
 	   }
-	   if {[catch {exec {*}[rtwiz_fbserv_cmd] &} pid] == 0} {
+	   if {[catch {exec {*}[rtwiz_fbserv_cmd] < NUL >> $::RtWizard::wizard_state(log_file) 2>@1 &} pid] == 0} {
 	       set fbserv_pid $pid
 	   } else {
 	       if {$::RtWizard::wizard_state(verbose)} {puts "fbserv launch on port $::RtWizard::wizard_state(fbserv_port) failed: $pid"}
@@ -248,7 +248,7 @@ if {[info exists ::use_gui]} {
 	   # refused — e.g. a token mismatch means another instance already owns the port
 	   # and we should advance to the next candidate immediately.
 	   set _fb_wait 0
-	   while { [catch {exec [file join [bu_dir bin] fblabel] -F [rtwiz_fb_target] 1 1 " "} _fb_err] && $_fb_wait < 30 && [string match {*can't connect*} $_fb_err] } {
+	   while { [catch {exec [file join [bu_dir bin] fblabel] -F [rtwiz_fb_target] 1 1 " " 2>@1} _fb_err] && $_fb_wait < 30 && [string match {*can't connect*} $_fb_err] } {
 	       after 300
 	       incr _fb_wait
 	   }
@@ -256,7 +256,7 @@ if {[info exists ::use_gui]} {
 	   # Verify that we actually own this fbserv: fblabel must succeed with our
 	   # FBSERV_TOKEN.  If it fails, another rtwizard won the race for this port
 	   # and our token was rejected — advance to the next candidate port and retry.
-	   if { [catch {exec {*}$fbserv_token_prefix [file join [bu_dir bin] fblabel] -F [rtwiz_fb_target] 1 1 " "}] == 0 } {
+	   if { [catch {exec {*}$fbserv_token_prefix [file join [bu_dir bin] fblabel] -F [rtwiz_fb_target] 1 1 " " 2>@1}] == 0 } {
 	       set fbserv_owned 1
 	   } else {
 	       if {$::RtWizard::wizard_state(verbose)} {
@@ -363,11 +363,11 @@ if {[info exists ::use_gui]} {
    if {[info exists ::RtWizard::wizard_state(output_filename)]} {
       set output_generated 0
       if {[file extension $::RtWizard::wizard_state(output_filename)] == ".png"} {
-	 exec [file join [bu_dir bin] fb-png] -w $::RtWizard::wizard_state(width) -n $::RtWizard::wizard_state(scanlines) -F [rtwiz_fb_target] $::RtWizard::wizard_state(output_filename)
+	 exec [file join [bu_dir bin] fb-png] -w $::RtWizard::wizard_state(width) -n $::RtWizard::wizard_state(scanlines) -F [rtwiz_fb_target] $::RtWizard::wizard_state(output_filename) 2>@1
 	 set output_generated 1
       }
       if {!$output_generated} {
-	 exec [file join [bu_dir bin] fb-pix] -w $::RtWizard::wizard_state(width) -n $::RtWizard::wizard_state(scanlines) -F [rtwiz_fb_target] $::RtWizard::wizard_state(output_filename)
+	 exec [file join [bu_dir bin] fb-pix] -w $::RtWizard::wizard_state(width) -n $::RtWizard::wizard_state(scanlines) -F [rtwiz_fb_target] $::RtWizard::wizard_state(output_filename) 2>@1
 	 set output_generated 1
       }
 
@@ -391,7 +391,7 @@ if {[info exists ::use_gui]} {
 	      }
 	  }
 	  if {$kill_cmd != ""} {
-	      exec {*}$kill_args
+	      catch {exec {*}$kill_args}
 	  }
       }
    }