[RFA] Set path to iwidgets.

[RFA] Set path to iwidgets.

[Ian Roxborough]

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 ----

Re: [RFA] Set path to iwidgets.

[Keith Seitz]

On Mon, 10 Sep 2001, Ian Roxborough wrote:

> 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.

Very good! This patch is approved.

Just two last nits:

1) Need "library/" prefix on util.tcl and main.tcl.
2) The patches are related, so please remove newlines between changelog
entries before committing. Only put newlines when the changes are not
related (see GNU coding standard on this). Yeah, it's stupid, but it's
something that I've grown accustomed to looking at in ChangeLogs now.

Thanks!
Keith


> 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 ----
>

Re: [RFA] Set path to iwidgets.

[Ian Roxborough]

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.
	* library/util.tcl (find_iwidgets_library): Removed.
	* library/main.tcl: Don't call find_iwidgets_library, do a
	  package require instead.

Keith Seitz wrote:
> 1) Need "library/" prefix on util.tcl and main.tcl.

Duh!

> 2) The patches are related, so please remove newlines between changelog
> entries before committing. Only put newlines when the changes are not
> related (see GNU coding standard on this). Yeah, it's stupid, but it's
> something that I've grown accustomed to looking at in ChangeLogs now.

Sounds good to me.  

I'll check in the patch then,

Thanks,
Ian.

Re: [RFA] Set path to iwidgets.

[Keith Seitz]

On Mon, 10 Sep 2001, Ian Roxborough wrote:

> 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.
> 	* library/util.tcl (find_iwidgets_library): Removed.
> 	* library/main.tcl: Don't call find_iwidgets_library, do a
> 	  package require instead.

Excellent!

> I'll check in the patch then,

Great! Thanks a bunch!

Keith