This is the mail archive of the
insight@sources.redhat.com
mailing list for the Insight project.
[RFA] Set path to iwidgets.
- To: insight at sources dot redhat dot com
- Subject: [RFA] Set path to iwidgets.
- From: Ian Roxborough <irox at redhat dot com>
- Date: Mon, 10 Sep 2001 12:01:49 -0700
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 <irox@redhat.com>
* 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 ----