BRL-CAD
tclcadAutoPath.c
Go to the documentation of this file.
1 /* T C L C A D A U T O P A T H . C
2  * BRL-CAD
3  *
4  * Copyright (c) 2004-2014 United States Government as represented by
5  * the U.S. Army Research Laboratory.
6  *
7  * This program is free software; you can redistribute it and/or
8  * modify it under the terms of the GNU Lesser General Public License
9  * version 2.1 as published by the Free Software Foundation.
10  *
11  * This program is distributed in the hope that it will be useful, but
12  * WITHOUT ANY WARRANTY; without even the implied warranty of
13  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14  * Lesser General Public License for more details.
15  *
16  * You should have received a copy of the GNU Lesser General Public
17  * License along with this file; see the file named COPYING for more
18  * information.
19  *
20  */
21 /** @file libtclcad/tclcadAutoPath.c
22  *
23  * Locate the BRL-CAD tclscripts
24  *
25  */
26 
27 #include "common.h"
28 
29 #include <stdarg.h>
30 #include <stdlib.h>
31 #include <stdio.h>
32 #include <string.h>
33 
34 #include "tcl.h"
35 #ifdef HAVE_TK
36 # include "tk.h"
37 #endif
38 
39 #include "tclcad.h"
40 
41 #define MAX_BUF 2048
42 
43 /* FIXME: we utilize this Tcl internal in here */
44 #if !defined(_WIN32) || defined(__CYGWIN__)
45 extern Tcl_Obj *TclGetLibraryPath (void);
46 #endif
47 
48 
49 /* helper routine to determine whether the full 'path' includes a
50  * directory named 'src'. this is used to determine whether a
51  * particular invocation is being run from the BRL-CAD source
52  * directories or from some install directory.
53  *
54  * returns a pointer to the subpath that contains the 'src' directory.
55  * e.g. provided /some/path/to/src/dir/blah will return /some/path/to
56  */
57 static const char *
58 path_to_src(const char *path)
59 {
60  static char buffer[MAX_BUF] = {0};
61  char *match = NULL;
62 
63  if (!path) {
64  return NULL;
65  }
66  if (strlen(path)+2 > MAX_BUF) {
67  /* path won't fit */
68  return NULL;
69  }
70 
71  snprintf(buffer, MAX_BUF, "%s%c", path, BU_DIR_SEPARATOR);
72 
73  match = strstr(buffer, "/src/");
74  if (match) {
75  *(match) = '\0';
76  return buffer;
77  }
78  return NULL;
79 }
80 
81 /* Appends a new path to the path list, preceded by BU_PATH_SEPARATOR.
82  *
83  * The path is specified as a sequence of string arguments, one per
84  * directory, terminated by a (const char *)NULL argument.
85  *
86  * BU_DIR_SEPARATOR is inserted between the string arguments (but not
87  * before or after the path).
88  */
89 static void
90 join_path(struct bu_vls *path_list, ...)
91 {
92  va_list ap;
93  const char *dir;
94 
95  bu_vls_putc(path_list, BU_PATH_SEPARATOR);
96 
97  va_start(ap, path_list);
98 
99  dir = va_arg(ap, const char *);
100  while (dir != NULL) {
101  bu_vls_printf(path_list, "%s", dir);
102 
103  dir = va_arg(ap, const char *);
104  if (dir != NULL) {
105  bu_vls_putc(path_list, BU_DIR_SEPARATOR);
106  }
107  }
108  va_end(ap);
109 }
110 
111 /**
112  * Set up the Tcl auto_path for locating various necessary BRL-CAD
113  * scripting resources. Detect whether the current invocation is from
114  * an installed binary or not and append to the auto_path accordingly
115  * for where the needed tclscript resources should be found.
116  *
117  ** installed invocation paths
118  * BRLCAD_ROOT/lib/tclTCL_VERSION/init.tcl
119  * BRLCAD_ROOT/lib/tclTK_VERSION/tk.tcl
120  * BRLCAD_ROOT/lib/itclITCL_VERSION/itcl.tcl
121  * BRLCAD_ROOT/lib/itkITCL_VERSION/itk.tcl
122  * BRLCAD_ROOT/lib/iwidgetsIWIDGETS_VERSION/iwidgets.tcl
123  * BRLCAD_DATA/tclscripts/pkgIndex.tcl and subdirs
124  *
125  ** source invocation paths
126  * src/other/tcl/library/init.tcl
127  * src/other/tk/library/tk.tcl
128  * src/other/incrTcl/itcl/library/itcl.tcl
129  * src/other/incrTcl/itk/library/itk.tcl
130  * src/other/iwidgets/library/iwidgets.tcl
131  * src/tclscripts/pkgIndex.tcl and subdirs
132  *
133  * if TCLCAD_LIBRARY_PATH is set
134  * append to search path
135  * get installation directory and invocation path
136  * if being run from installation directory
137  * add installation paths to search path
138  * if being run from source directory
139  * add source paths to search path
140  * add installation paths to search path
141  */
142 void
144 {
145  struct bu_vls auto_path = BU_VLS_INIT_ZERO;
146  struct bu_vls lappend = BU_VLS_INIT_ZERO;
147  const char *library_path = NULL;
148 
149  struct bu_vls root_buf = BU_VLS_INIT_ZERO;
150  const char *root = NULL;
151  const char *data = NULL;
152  char buffer[MAX_BUF] = {0};
153 
154  const char *which_argv = NULL;
155  const char *srcpath = NULL;
156  int from_installed = 0;
157 
158  int found_init_tcl = 0;
159  int found_tk_tcl = 0;
160  int found_itcl_tcl = 0;
161  int found_itk_tcl = 0;
162 
163  char pathsep[2] = { BU_PATH_SEPARATOR, '\0' };
164 
165  struct bu_vls tcl = BU_VLS_INIT_ZERO;
166  struct bu_vls itcl = BU_VLS_INIT_ZERO;
167 #ifdef HAVE_TK
168  struct bu_vls tk = BU_VLS_INIT_ZERO;
169  struct bu_vls itk = BU_VLS_INIT_ZERO;
170  struct bu_vls iwidgets = BU_VLS_INIT_ZERO;
171 #endif
172 
173  if (!interp) {
174  /* nothing to do */
175  return;
176  }
177 
178  bu_vls_printf(&tcl, "tcl%s", TCL_VERSION);
179  bu_vls_printf(&itcl, "itcl%s", ITCL_VERSION);
180 #ifdef HAVE_TK
181  bu_vls_printf(&tk, "tk%s", TK_VERSION);
182  bu_vls_printf(&itk, "itk%s", ITCL_VERSION);
183  bu_vls_printf(&iwidgets, "iwidgets%s", IWIDGETS_VERSION);
184 #endif
185 
186  root = bu_brlcad_root("", 1);
187  bu_vls_printf(&root_buf, "%s", root);
188  root = bu_vls_addr(&root_buf);
189  data = bu_brlcad_data("", 1);
190 
191  /* determine if TCLCAD_LIBRARY_PATH is set */
192  library_path = getenv("TCLCAD_LIBRARY_PATH");
193  if (library_path) {
194  /* it is set, set auto_path. limit buf just because. */
195  bu_vls_strncat(&auto_path, library_path, MAX_BUF);
196  }
197 
198  /* make sure tcl_library path is in the auto_path */
199  snprintf(buffer, MAX_BUF, "set tcl_library");
200  Tcl_Eval(interp, buffer);
201  bu_vls_strncat(&auto_path, Tcl_GetStringResult(interp), MAX_BUF);
202 
203  /* get string of invocation binary */
204  which_argv = bu_which(bu_argv0_full_path());
205  if (!which_argv) {
206  which_argv = bu_argv0_full_path();
207  }
208 
209  /* get name of installation binary */
210  snprintf(buffer, MAX_BUF, "%s%cbin%c%s", root, BU_DIR_SEPARATOR, BU_DIR_SEPARATOR, bu_getprogname());
211 
212  /* are we running from an installed binary? if so add to path */
213  if (bu_file_exists(buffer, NULL) && bu_same_file(buffer, which_argv)) {
214  from_installed = 1;
215  join_path(&auto_path, root, "lib", NULL);
216  join_path(&auto_path, root, "lib", bu_vls_addr(&tcl), NULL);
217 #ifdef HAVE_TK
218  join_path(&auto_path, root, "lib", bu_vls_addr(&tk), NULL);
219 #endif
220  join_path(&auto_path, root, "lib", bu_vls_addr(&itcl), NULL);
221 #ifdef HAVE_TK
222  join_path(&auto_path, root, "lib", bu_vls_addr(&itk), NULL);
223  join_path(&auto_path, root, "lib", bu_vls_addr(&iwidgets), NULL);
224 #endif
225  join_path(&auto_path, data, "tclscripts", NULL);
226  join_path(&auto_path, data, "tclscripts", "lib", NULL);
227  join_path(&auto_path, data, "tclscripts", "util", NULL);
228  join_path(&auto_path, data, "tclscripts", "mged", NULL);
229  join_path(&auto_path, data, "tclscripts", "geometree", NULL);
230  join_path(&auto_path, data, "tclscripts", "graph", NULL);
231  join_path(&auto_path, data, "tclscripts", "rtwizard", NULL);
232  join_path(&auto_path, data, "tclscripts", "archer", NULL);
233  join_path(&auto_path, data, "tclscripts", "boteditor", NULL);
234  join_path(&auto_path, data, "tclscripts", "lod", NULL);
235  }
236 
237  /* are we running uninstalled? */
238  srcpath = path_to_src(which_argv);
239 
240  /* add search paths for source invocation */
241  if (srcpath) {
242  join_path(&auto_path, srcpath, "src", "other", "tcl", "unix", NULL);
243  join_path(&auto_path, srcpath, "src", "other", "tcl", "library", NULL);
244  join_path(&auto_path, srcpath, "src", "other", "tk", "unix", NULL);
245  join_path(&auto_path, srcpath, "src", "other", "tk", "library", NULL);
246  join_path(&auto_path, srcpath, "src", "other", "incrTcl", NULL);
247  join_path(&auto_path, srcpath, "src", "other", "incrTcl", "itcl", "library", NULL);
248  join_path(&auto_path, srcpath, "src", "other", "incrTcl", "itk", "library", NULL);
249  join_path(&auto_path, srcpath, "src", "other", "iwidgets", NULL);
250  join_path(&auto_path, srcpath, "src", "tclscripts", NULL);
251  join_path(&auto_path, srcpath, "src", "tclscripts", "lib", NULL);
252  join_path(&auto_path, srcpath, "src", "tclscripts", "util", NULL);
253  join_path(&auto_path, srcpath, "src", "tclscripts", "mged", NULL);
254  join_path(&auto_path, srcpath, "src", "tclscripts", "geometree", NULL);
255  join_path(&auto_path, srcpath, "src", "tclscripts", "graph", NULL);
256  join_path(&auto_path, srcpath, "src", "tclscripts", "rtwizard", NULL);
257  join_path(&auto_path, srcpath, "src", "tclscripts", "archer", NULL);
258  join_path(&auto_path, srcpath, "src", "tclscripts", "boteditor", NULL);
259  join_path(&auto_path, srcpath, "src", "tclscripts", "lod", NULL);
260  }
261 
262  /* add search paths for dist invocation */
263  if (srcpath) {
264  snprintf(buffer, MAX_BUF, "%s%c..%csrc%cother%ctcl%cunix",
266  if (bu_file_exists(buffer, NULL)) {
267  join_path(&auto_path, srcpath, "..", "src", "other", "tcl", "unix", NULL);
268  join_path(&auto_path, srcpath, "..", "src", "other", "tcl", "library", NULL);
269  join_path(&auto_path, srcpath, "..", "src", "other", "tk", "unix", NULL);
270  join_path(&auto_path, srcpath, "..", "src", "other", "tk", "library", NULL);
271  join_path(&auto_path, srcpath, "..", "src", "other", "incrTcl", NULL);
272  join_path(&auto_path, srcpath, "..", "src", "other", "incrTcl", "itcl", "library", NULL);
273  join_path(&auto_path, srcpath, "..", "src", "other", "incrTcl", "itk", "library", NULL);
274  join_path(&auto_path, srcpath, "..", "src", "other", "iwidgets", NULL);
275  join_path(&auto_path, srcpath, "..", "src", "tclscripts", NULL);
276  join_path(&auto_path, srcpath, "..", "src", "tclscripts", "lib", NULL);
277  join_path(&auto_path, srcpath, "..", "src", "tclscripts", "util", NULL);
278  join_path(&auto_path, srcpath, "..", "src", "tclscripts", "mged", NULL);
279  join_path(&auto_path, srcpath, "..", "src", "tclscripts", "geometree", NULL);
280  join_path(&auto_path, srcpath, "..", "src", "tclscripts", "graph", NULL);
281  join_path(&auto_path, srcpath, "..", "src", "tclscripts", "rtwizard", NULL);
282  join_path(&auto_path, srcpath, "..", "src", "tclscripts", "archer", NULL);
283  join_path(&auto_path, srcpath, "..", "src", "tclscripts", "boteditor", NULL);
284  }
285  }
286 
287  /* be sure to check installation paths even if we aren't running from there */
288  if (!from_installed) {
289  join_path(&auto_path, root, "lib", NULL);
290  join_path(&auto_path, root, "lib", bu_vls_addr(&tcl), NULL);
291 #ifdef HAVE_TK
292  join_path(&auto_path, root, "lib", bu_vls_addr(&tk), NULL);
293 #endif
294  join_path(&auto_path, root, "lib", bu_vls_addr(&itcl), NULL);
295 #ifdef HAVE_TK
296  join_path(&auto_path, root, "lib", bu_vls_addr(&itk), NULL);
297  join_path(&auto_path, root, "lib", bu_vls_addr(&iwidgets), NULL);
298 #endif
299  join_path(&auto_path, data, "tclscripts", NULL);
300  join_path(&auto_path, data, "tclscripts", "lib", NULL);
301  join_path(&auto_path, data, "tclscripts", "util", NULL);
302  join_path(&auto_path, data, "tclscripts", "mged", NULL);
303  join_path(&auto_path, data, "tclscripts", "geometree", NULL);
304  join_path(&auto_path, data, "tclscripts", "graph", NULL);
305  join_path(&auto_path, data, "tclscripts", "rtwizard", NULL);
306  join_path(&auto_path, data, "tclscripts", "archer", NULL);
307  join_path(&auto_path, data, "tclscripts", "boteditor", NULL);
308  join_path(&auto_path, data, "tclscripts", "lod", NULL);
309  }
310 
311  /* printf("AUTO_PATH IS %s\n", bu_vls_addr(&auto_path)); */
312 
313  /* see if user already set ITCL_LIBRARY override */
314  library_path = getenv("ITCL_LIBRARY");
315  if (!found_itcl_tcl && library_path) {
316  snprintf(buffer, MAX_BUF, "%s%citcl.tcl", library_path, BU_DIR_SEPARATOR);
317  if (bu_file_exists(buffer, NULL)) {
318  found_itcl_tcl=1;
319  }
320  }
321 
322  /* see if user already set ITK_LIBRARY override */
323  library_path = getenv("ITK_LIBRARY");
324  if (!found_itk_tcl && library_path) {
325  snprintf(buffer, MAX_BUF, "%s%citk.tcl", library_path, BU_DIR_SEPARATOR);
326  if (bu_file_exists(buffer, NULL)) {
327  found_itk_tcl=1;
328  }
329  }
330 
331  /* iterate over the auto_path list and modify the real Tcl auto_path */
332  for (srcpath = strtok(bu_vls_addr(&auto_path), pathsep);
333  srcpath;
334  srcpath = strtok(NULL, pathsep)) {
335 
336  /* make sure it exists before appending */
337  if (bu_file_exists(srcpath, NULL)) {
338  /* printf("APPENDING: %s\n", srcpath); */
339  bu_vls_sprintf(&lappend, "lappend auto_path {%s}", srcpath);
340  (void)Tcl_Eval(interp, bu_vls_addr(&lappend));
341  } else {
342  /* printf("NOT APPENDING: %s\n", srcpath); */
343  continue;
344  }
345 
346  /* specifically look for init.tcl so we can set tcl_library */
347  if (!found_init_tcl) {
348  snprintf(buffer, MAX_BUF, "%s%cinit.tcl", srcpath, BU_DIR_SEPARATOR);
349  if (bu_file_exists(buffer, NULL)) {
350  /* this really sets it */
351  snprintf(buffer, MAX_BUF, "set tcl_library {%s}", srcpath);
352  if (Tcl_Eval(interp, buffer)) {
353  bu_log("Tcl_Eval ERROR:\n%s\n", Tcl_GetStringResult(interp));
354  } else {
355  found_init_tcl=1;
356  }
357 
358  /* extra measures necessary for "create interp":
359  * determine if TCL_LIBRARY is set, and set it if not.
360  */
361  library_path = getenv("TCL_LIBRARY");
362  if (!library_path) {
363  /* this REALLY sets it */
364  snprintf(buffer, MAX_BUF, "set env(TCL_LIBRARY) {%s}", srcpath);
365  if (Tcl_Eval(interp, buffer)) {
366  bu_log("Tcl_Eval ERROR:\n%s\n", Tcl_GetStringResult(interp));
367  }
368  }
369  }
370  }
371 
372  /* specifically look for tk.tcl so we can set tk_library */
373  if (!found_tk_tcl) {
374  snprintf(buffer, MAX_BUF, "%s%ctk.tcl", srcpath, BU_DIR_SEPARATOR);
375  if (bu_file_exists(buffer, NULL)) {
376  /* this really sets it */
377  snprintf(buffer, MAX_BUF, "set tk_library {%s}", srcpath);
378  if (Tcl_Eval(interp, buffer)) {
379  bu_log("Tcl_Eval ERROR:\n%s\n", Tcl_GetStringResult(interp));
380  } else {
381  found_tk_tcl=1;
382  }
383  }
384  }
385 
386  /* specifically look for itcl.tcl so we can set ITCL_LIBRARY */
387  if (!found_itcl_tcl) {
388  snprintf(buffer, MAX_BUF, "%s%citcl.tcl", srcpath, BU_DIR_SEPARATOR);
389  if (bu_file_exists(buffer, NULL)) {
390  /* this really sets it */
391  snprintf(buffer, MAX_BUF, "set env(ITCL_LIBRARY) {%s}", srcpath);
392  if (Tcl_Eval(interp, buffer)) {
393  bu_log("Tcl_Eval ERROR:\n%s\n", Tcl_GetStringResult(interp));
394  } else {
395  found_itcl_tcl=1;
396  }
397  }
398  }
399 
400  /* specifically look for itk.tcl so we can set ITK_LIBRARY */
401  if (!found_itk_tcl) {
402  snprintf(buffer, MAX_BUF, "%s%citk.tcl", srcpath, BU_DIR_SEPARATOR);
403  if (bu_file_exists(buffer, NULL)) {
404  /* this really sets it */
405  snprintf(buffer, MAX_BUF, "set env(ITK_LIBRARY) {%s}", srcpath);
406  if (Tcl_Eval(interp, buffer)) {
407  bu_log("Tcl_Eval ERROR:\n%s\n", Tcl_GetStringResult(interp));
408  } else {
409  found_itk_tcl=1;
410  }
411  }
412  }
413  }
414 
415  which_argv = NULL;
416  bu_vls_free(&tcl);
417  bu_vls_free(&itcl);
418 #ifdef HAVE_TK
419  bu_vls_free(&tk);
420  bu_vls_free(&itk);
421  bu_vls_free(&iwidgets);
422 #endif
423  bu_vls_free(&auto_path);
424  bu_vls_free(&lappend);
425  bu_vls_free(&root_buf);
426 
427  return;
428 }
429 
430 /*
431  * Local Variables:
432  * mode: C
433  * tab-width: 8
434  * indent-tabs-mode: t
435  * c-file-style: "stroustrup"
436  * End:
437  * ex: shiftwidth=4 tabstop=8
438  */
void bu_log(const char *,...) _BU_ATTR_PRINTF12
Definition: log.c:176
void bu_vls_strncat(struct bu_vls *vp, const char *s, size_t n)
Definition: vls.c:390
ustring interp
Header file for the BRL-CAD common definitions.
#define MAX_BUF
const char * bu_brlcad_data(const char *rhs, int fail_quietly)
Definition: brlcad_path.c:405
void bu_vls_free(struct bu_vls *vp)
Definition: vls.c:248
COMPLEX data[64]
Definition: fftest.c:34
void bu_vls_sprintf(struct bu_vls *vls, const char *fmt,...) _BU_ATTR_PRINTF23
Definition: vls.c:707
const char * bu_which(const char *cmd)
Definition: which.c:43
const char * bu_getprogname(void)
Definition: progname.c:96
char * strtok(char *s, const char *delim)
#define BU_PATH_SEPARATOR
Definition: defines.h:127
int bu_same_file(const char *fn1, const char *fn2)
Definition: file.c:101
char * bu_vls_addr(const struct bu_vls *vp)
Definition: vls.c:111
#define BU_DIR_SEPARATOR
Definition: defines.h:97
Tcl_Obj * TclGetLibraryPath(void)
void bu_vls_printf(struct bu_vls *vls, const char *fmt,...) _BU_ATTR_PRINTF23
Definition: vls.c:694
Header file for the BRL-CAD TclCAD Library, LIBTCLCAD.
void tclcad_auto_path(Tcl_Interp *interp)
#define BU_VLS_INIT_ZERO
Definition: vls.h:84
const char * bu_brlcad_root(const char *rhs, int fail_quietly)
Definition: brlcad_path.c:292
Definition: vls.h:56
void bu_vls_putc(struct bu_vls *vp, int c)
Definition: vls.c:666
int bu_file_exists(const char *path, int *fd)
Definition: file.c:57
const char * bu_argv0_full_path(void)
Definition: progname.c:48