From mboxrd@z Thu Jan 1 00:00:00 1970 From: Ian Roxborough To: insight@sources.redhat.com Subject: [RFA] Set path to iwidgets. Date: Mon, 10 Sep 2001 12:02:00 -0000 Message-id: <3B9D0E1D.C27C884@redhat.com> X-SW-Source: 2001-q3/msg00248.html Hi again, this patch sets the IWIDGETS_LIBRARY environment variable if Insight is ran from the build directory. It also removes a some code which no longer works (it depended and a hack in the Tcl library loader which I have removed). Ian. 2001-09-10 Ian Roxborough * generic/gdbtk.c (gdbtk_init): Set IWIDGETS_LIBRARY if Insight is launched from within the build directory. * util.tcl (find_iwidgets_library): Removed. * main.tcl: Don't call find_iwidgets_library, do a package require instead. Index: generic/gdbtk.c =================================================================== RCS file: /cvs/src/src/gdb/gdbtk/generic/gdbtk.c,v retrieving revision 1.20 diff -p -r1.20 gdbtk.c *** gdbtk.c 2001/08/21 19:29:00 1.20 --- gdbtk.c 2001/09/10 18:51:33 *************** gdbtk_init (argv0) *** 423,428 **** --- 423,433 ---- set env(ITK_LIBRARY) [file join $srcDir itcl itk library]\n\ }\n\ \ + if {![info exists env(IWIDGETS_LIBRARY)]} {\n\ + set env(IWIDGETS_LIBRARY)\ + [file join $srcDir itcl iwidgets3.0.0 generic]\n\ + }\n\ + \ if {![info exists env(TIX_LIBRARY)]} {\n\ set env(TIX_LIBRARY) [file join $srcDir tix library]\n\ }\n\ cvs server: Diffing library Index: library/main.tcl =================================================================== RCS file: /cvs/src/src/gdb/gdbtk/library/main.tcl,v retrieving revision 1.3 diff -p -r1.3 main.tcl *** main.tcl 2001/05/03 18:13:21 1.3 --- main.tcl 2001/09/10 18:51:34 *************** namespace import itcl::* *** 58,64 **** namespace import debug::* ! if {![find_iwidgets_library]} { set msg "Could not find the Iwidgets libraries.\n\nGot nameofexec: [info nameofexecutable]\nError(s) were: \n$errMsg" if {![info exists ::env(GDBTK_TEST_RUNNING)] || $::env(GDBTK_TEST_RUNNING) == 0} { --- 58,64 ---- namespace import debug::* ! if {[catch {package require Iwidgets 3.0} errMsg]} { set msg "Could not find the Iwidgets libraries.\n\nGot nameofexec: [info nameofexecutable]\nError(s) were: \n$errMsg" if {![info exists ::env(GDBTK_TEST_RUNNING)] || $::env(GDBTK_TEST_RUNNING) == 0} { Index: library/util.tcl =================================================================== RCS file: /cvs/src/src/gdb/gdbtk/library/util.tcl,v retrieving revision 1.8 diff -p -r1.8 util.tcl *** util.tcl 2001/07/19 17:40:09 1.8 --- util.tcl 2001/09/10 18:51:35 *************** proc gridCGet {slave option} { *** 216,305 **** } # ------------------------------------------------------------------ - # PROC: find_iwidgets_library - Find the IWidgets library. - # - # This is a little bit of bogosity which is necessary so we - # can find the iwidgets libraries if we are not installed: - # The problem is that the iwidgets are really weird. The init file is - # in the build tree, but all the library files are in the source tree... - # - # ------------------------------------------------------------------ - proc find_iwidgets_library {} { - global errMsg - - set IwidgetsOK 1 - - if {[catch {package require Iwidgets 3.0} errMsg]} { - - # OK, we are not installed or this would have succeeded... - # Lets try to do it by hand: - set IwidgetsOK 0 - - set iwidgetsSrcDir [glob -nocomplain [file join \ - [file dirname [file dirname $::tcl_library]] \ - itcl iwidgets3*]] - - # Canonicalize the executable's directory name. It turns out that on Solaris, - # info nameofexecutable returns /foo/bar/real_dir/./gdb when gdb is launched from - # another gdb session, so we have to fix this up. - - set exec_name [info nameofexecutable] - set curdir [pwd] - if {[string compare [file type $exec_name] "link"] == 0} { - set exec_name [file readlink $exec_name] - if {[string compare [file pathtype $exec_name] "relative"] == 0} { - set exec_name [file join [pwd] $exec_name] - } - } - - cd [file dirname $exec_name] - set exec_name [pwd] - cd $curdir - - set iwidgetsBuildDir [glob -nocomplain [file join \ - [file dirname $exec_name] \ - itcl iwidgets3*]] - set initFile [file join [lindex $iwidgetsBuildDir 0] \ - unix iwidgets.tcl] - - if {[llength $iwidgetsBuildDir] == 0} { - # We could be runnning on an installed toolchain. - # Check in "normal" installed place: "../../share/iwidgets*" - set iwidgetsBuildDir [glob -nocomplain [file join \ - [file dirname [file dirname $exec_name]] \ - share iwidgets3*]] - set initFile [file join [lindex $iwidgetsBuildDir 0] iwidgets.tcl] - } - - if {[llength $iwidgetsSrcDir] == 1 && [llength $iwidgetsBuildDir] == 1} { - # The lindex is necessary because the path may have spaces in it... - set libDir [file join [lindex $iwidgetsSrcDir 0] generic] - if {[file exists $initFile] && [file isdirectory $libDir]} { - if {![catch {source $initFile} err]} { - # Now fix up the stuff the Iwidgets init file got wrong... - set libPos [lsearch $::auto_path [file join $::iwidgets::library scripts]] - if {$libPos >= 0} { - set auto_path [lreplace $::auto_path $libPos $libPos $libDir] - } else { - lappend ::auto_path $libDir - } - set ::iwidgets::library $libDir - set IwidgetsOK 1 - } else { - append errMsg "\nError in iwidgets.tcl file: $err" - } - } - } else { - append errMsg "\nCould not find in-place versions of the Iwidgets files\n" - append errMsg "Looked at: $iwidgetsSrcDir\n" - append errMsg "and: $iwidgetsBuildDir\n" - } - - } - return $IwidgetsOK - } - - # ------------------------------------------------------------------ # PROC: get_disassembly_flavor - gets the current disassembly flavor. # The set disassembly-flavor command is assumed to exist. This # will error out if it does not. --- 216,221 ----