Patch: session startup patch

Patch: session startup patch

[Tom Tromey]

I've updated my Insight session startup patch to use absolute paths
for the session names (this was requested last time I submitted the
patch).  This means that running Insight on an executable will
correctly load that executable's session, regardless of how the path
to the executable is actually specified.

This isn't fully bulletproof.  Certain sorts of symlinks will confuse
it.  I personally don't think this is very serious at this point.
Plus there is a clear (if non-trivial) fix if we ever need it: use
`realpath' instead of the current ad hoc scheme.

Ok to commit?

Tom

Index: ChangeLog
from  Tom Tromey  <tromey@redhat.com>

	* tclIndex: Updated.
	* library/main.tcl: Add session_notice_file_change to
	file_changed_hook.
	* library/session.tcl (session_load): Only load the executable.
	(session_notice_file_change): New proc.
	(SESSION_exe_name): New proc.
	(session_save): Use it.
	(session_notice_file_change): Likewise.
	* library/interface.tcl (gdbtk_tcl_exec_file_display): Don't call
	session_save.
	(gdbtk_tcl_preloop): Don't set executable name or try to find
	main.  Notice a new session if required.

Index: library/interface.tcl
===================================================================
RCS file: /cvs/src/src/gdb/gdbtk/library/interface.tcl,v
retrieving revision 1.30
diff -u -r1.30 interface.tcl
--- library/interface.tcl 2001/10/06 18:10:50 1.30
+++ library/interface.tcl 2001/10/27 18:41:25
@@ -111,14 +111,11 @@
   after idle gdbtk_idle 
   ManagedWin::startup
 
-  SrcWin::point_to_main
-  set msg ""
-  catch {gdb_cmd "info files"} msg
-  set line1 [string range $msg 0 [string first \n $msg]]  
-  if {[regexp {Symbols from "(.*)"\.} $line1 dummy name]} {
-    set gdb_exe_name $name
+  if {$gdb_exe_name != ""} {
+    # At startup, file_changed_hook is called too late for us, so we
+    # must notice the initial session by hand.
+    session_notice_file_change
   }
-
   
   gdbtk_update
 }
@@ -771,9 +768,6 @@
   }
   set_exe_name $filename
   set gdb_exe_changed 0
-
-  # Add this new session to the session list
-  session_save
 
   SrcWin::point_to_main
 }
Index: library/main.tcl
===================================================================
RCS file: /cvs/src/src/gdb/gdbtk/library/main.tcl,v
retrieving revision 1.5
diff -u -r1.5 main.tcl
--- library/main.tcl 2001/09/19 18:10:37 1.5
+++ library/main.tcl 2001/10/27 18:41:25
@@ -137,6 +137,9 @@
 
 init_disassembly_flavor
 
+# Arrange for session code to notice when file changes.
+add_hook file_changed_hook session_notice_file_change
+
 ManagedWin::init
 
 # This stuff will help us play nice with WindowMaker's AppIcons.
Index: library/session.tcl
===================================================================
RCS file: /cvs/src/src/gdb/gdbtk/library/session.tcl,v
retrieving revision 1.8
diff -u -r1.8 session.tcl
--- library/session.tcl 2001/10/06 18:10:50 1.8
+++ library/session.tcl 2001/10/27 18:41:25
@@ -11,6 +11,23 @@
 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 # GNU General Public License for more details.
 
+# An internal function for canonicalizing path names.  This probably
+# should use `realpath', but that is more work.  So for now we neglect
+# the possibility of symlinks.
+proc SESSION_exe_name {path} {
+  global tcl_platform
+
+  # Get real directory.
+  if {[string compare $tcl_platform(platform) "windows"] == 0} {
+    set path [ide_cygwin_path to_win32 $path]
+  }
+  set save [pwd]
+  cd [file dirname $path]
+  set dir [pwd]
+  cd $save
+  return [file join $dir [file tail $path]]
+}
+
 # An internal function used when saving sessions.  Returns a string
 # that can be used to recreate all pertinent breakpoint state.
 proc SESSION_serialize_bps {} {
@@ -110,14 +127,15 @@
   global gdb_current_directory gdb_source_path
 
   # gdb sessions are named after the executable.
-  set name $gdb_exe_name
+  set name [SESSION_exe_name $gdb_exe_name]
   set key gdb/session/$name
 
   # We fill a hash and then use that to set the actual preferences.
 
   # Always set the exe. name in case we later decide to change the
-  # interpretation of the session key.
-  set values(executable) $gdb_exe_name
+  # interpretation of the session key.  Use the full path to the
+  # executable.
+  set values(executable) $name
 
   # Some simple state the user wants.
   set values(args) [gdb_get_inferior_args]
@@ -157,6 +175,39 @@
     set values($k) [pref getd $key/$k]
   }
 
+  if {[info exists values(executable)]} {
+    gdb_clear_file
+    set_exe_name $values(executable)
+    set_exe
+  }
+}
+
+#
+# This is called from file_changed_hook.  It does all the work of
+# loading a session, if one exists with the same name as the current
+# executable.
+#
+proc session_notice_file_change {} {
+  global gdb_exe_name gdb_target_name
+
+  debug "noticed file change event for $gdb_exe_name"
+
+  # gdb sessions are named after the executable.
+  set name [SESSION_exe_name $gdb_exe_name]
+  set key gdb/session/$name
+
+  # Fetch all keys for this session into an array.
+  foreach k [pref getd $key/all-keys] {
+    set values($k) [pref getd $key/$k]
+  }
+
+  if {! [info exists values(executable)] || $values(executable) != $name} {
+    # No such session.
+    return
+  }
+
+  debug "reloading session for $gdb_exe_name"
+
   if {[info exists values(dirs)]} {
     # FIXME: short-circuit confirmation.
     gdb_cmd "directory"
@@ -169,12 +220,6 @@
 
   if {[info exists values(args)]} {
     gdb_set_inferior_args $values(args)
-  }
-
-  if {[info exists values(executable)]} {
-    gdb_clear_file
-    set_exe_name $values(executable)
-    set_exe
   }
 
   if {[info exists values(breakpoints)]} {
Index: library/tclIndex
===================================================================
RCS file: /cvs/src/src/gdb/gdbtk/library/tclIndex,v
retrieving revision 1.20
diff -u -r1.20 tclIndex
--- library/tclIndex 2001/10/04 15:01:36 1.20
+++ library/tclIndex 2001/10/27 18:41:26
@@ -94,6 +94,7 @@
 set auto_index(session_load) [list source [file join $dir session.tcl]]
 set auto_index(session_delete) [list source [file join $dir session.tcl]]
 set auto_index(session_list) [list source [file join $dir session.tcl]]
+set auto_index(session_notice_file_change) [list source [file join $dir session.tcl]]
 set auto_index(TdumpWin) [list source [file join $dir tdump.tcl]]
 set auto_index(TfindArgs) [list source [file join $dir tfind_args.tcl]]
 set auto_index(oldGDBToolBar) [list source [file join $dir toolbar.tcl]]

Re: Patch: session startup patch

[Fernando Nasser]

Tom Tromey wrote:
> 
> I've updated my Insight session startup patch to use absolute paths
> for the session names (this was requested last time I submitted the
> patch).  This means that running Insight on an executable will
> correctly load that executable's session, regardless of how the path
> to the executable is actually specified.
> 
> This isn't fully bulletproof.  Certain sorts of symlinks will confuse
> it.  I personally don't think this is very serious at this point.
> Plus there is a clear (if non-trivial) fix if we ever need it: use
> `realpath' instead of the current ad hoc scheme.
> 
> Ok to commit?
> 
> Tom
> 

OK with me. And this is basically confined to your own code anyway.

Tom, thanks again for all the session stuff.

Fernando


> Index: ChangeLog
> from  Tom Tromey  <tromey@redhat.com>
> 
>         * tclIndex: Updated.
>         * library/main.tcl: Add session_notice_file_change to
>         file_changed_hook.
>         * library/session.tcl (session_load): Only load the executable.
>         (session_notice_file_change): New proc.
>         (SESSION_exe_name): New proc.
>         (session_save): Use it.
>         (session_notice_file_change): Likewise.
>         * library/interface.tcl (gdbtk_tcl_exec_file_display): Don't call
>         session_save.
>         (gdbtk_tcl_preloop): Don't set executable name or try to find
>         main.  Notice a new session if required.
> 
> Index: library/interface.tcl
> ===================================================================
> RCS file: /cvs/src/src/gdb/gdbtk/library/interface.tcl,v
> retrieving revision 1.30
> diff -u -r1.30 interface.tcl
> --- library/interface.tcl 2001/10/06 18:10:50 1.30
> +++ library/interface.tcl 2001/10/27 18:41:25
> @@ -111,14 +111,11 @@
>    after idle gdbtk_idle
>    ManagedWin::startup
> 
> -  SrcWin::point_to_main
> -  set msg ""
> -  catch {gdb_cmd "info files"} msg
> -  set line1 [string range $msg 0 [string first \n $msg]]
> -  if {[regexp {Symbols from "(.*)"\.} $line1 dummy name]} {
> -    set gdb_exe_name $name
> +  if {$gdb_exe_name != ""} {
> +    # At startup, file_changed_hook is called too late for us, so we
> +    # must notice the initial session by hand.
> +    session_notice_file_change
>    }
> -
> 
>    gdbtk_update
>  }
> @@ -771,9 +768,6 @@
>    }
>    set_exe_name $filename
>    set gdb_exe_changed 0
> -
> -  # Add this new session to the session list
> -  session_save
> 
>    SrcWin::point_to_main
>  }
> Index: library/main.tcl
> ===================================================================
> RCS file: /cvs/src/src/gdb/gdbtk/library/main.tcl,v
> retrieving revision 1.5
> diff -u -r1.5 main.tcl
> --- library/main.tcl 2001/09/19 18:10:37 1.5
> +++ library/main.tcl 2001/10/27 18:41:25
> @@ -137,6 +137,9 @@
> 
>  init_disassembly_flavor
> 
> +# Arrange for session code to notice when file changes.
> +add_hook file_changed_hook session_notice_file_change
> +
>  ManagedWin::init
> 
>  # This stuff will help us play nice with WindowMaker's AppIcons.
> Index: library/session.tcl
> ===================================================================
> RCS file: /cvs/src/src/gdb/gdbtk/library/session.tcl,v
> retrieving revision 1.8
> diff -u -r1.8 session.tcl
> --- library/session.tcl 2001/10/06 18:10:50 1.8
> +++ library/session.tcl 2001/10/27 18:41:25
> @@ -11,6 +11,23 @@
>  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
>  # GNU General Public License for more details.
> 
> +# An internal function for canonicalizing path names.  This probably
> +# should use `realpath', but that is more work.  So for now we neglect
> +# the possibility of symlinks.
> +proc SESSION_exe_name {path} {
> +  global tcl_platform
> +
> +  # Get real directory.
> +  if {[string compare $tcl_platform(platform) "windows"] == 0} {
> +    set path [ide_cygwin_path to_win32 $path]
> +  }
> +  set save [pwd]
> +  cd [file dirname $path]
> +  set dir [pwd]
> +  cd $save
> +  return [file join $dir [file tail $path]]
> +}
> +
>  # An internal function used when saving sessions.  Returns a string
>  # that can be used to recreate all pertinent breakpoint state.
>  proc SESSION_serialize_bps {} {
> @@ -110,14 +127,15 @@
>    global gdb_current_directory gdb_source_path
> 
>    # gdb sessions are named after the executable.
> -  set name $gdb_exe_name
> +  set name [SESSION_exe_name $gdb_exe_name]
>    set key gdb/session/$name
> 
>    # We fill a hash and then use that to set the actual preferences.
> 
>    # Always set the exe. name in case we later decide to change the
> -  # interpretation of the session key.
> -  set values(executable) $gdb_exe_name
> +  # interpretation of the session key.  Use the full path to the
> +  # executable.
> +  set values(executable) $name
> 
>    # Some simple state the user wants.
>    set values(args) [gdb_get_inferior_args]
> @@ -157,6 +175,39 @@
>      set values($k) [pref getd $key/$k]
>    }
> 
> +  if {[info exists values(executable)]} {
> +    gdb_clear_file
> +    set_exe_name $values(executable)
> +    set_exe
> +  }
> +}
> +
> +#
> +# This is called from file_changed_hook.  It does all the work of
> +# loading a session, if one exists with the same name as the current
> +# executable.
> +#
> +proc session_notice_file_change {} {
> +  global gdb_exe_name gdb_target_name
> +
> +  debug "noticed file change event for $gdb_exe_name"
> +
> +  # gdb sessions are named after the executable.
> +  set name [SESSION_exe_name $gdb_exe_name]
> +  set key gdb/session/$name
> +
> +  # Fetch all keys for this session into an array.
> +  foreach k [pref getd $key/all-keys] {
> +    set values($k) [pref getd $key/$k]
> +  }
> +
> +  if {! [info exists values(executable)] || $values(executable) != $name} {
> +    # No such session.
> +    return
> +  }
> +
> +  debug "reloading session for $gdb_exe_name"
> +
>    if {[info exists values(dirs)]} {
>      # FIXME: short-circuit confirmation.
>      gdb_cmd "directory"
> @@ -169,12 +220,6 @@
> 
>    if {[info exists values(args)]} {
>      gdb_set_inferior_args $values(args)
> -  }
> -
> -  if {[info exists values(executable)]} {
> -    gdb_clear_file
> -    set_exe_name $values(executable)
> -    set_exe
>    }
> 
>    if {[info exists values(breakpoints)]} {
> Index: library/tclIndex
> ===================================================================
> RCS file: /cvs/src/src/gdb/gdbtk/library/tclIndex,v
> retrieving revision 1.20
> diff -u -r1.20 tclIndex
> --- library/tclIndex 2001/10/04 15:01:36 1.20
> +++ library/tclIndex 2001/10/27 18:41:26
> @@ -94,6 +94,7 @@
>  set auto_index(session_load) [list source [file join $dir session.tcl]]
>  set auto_index(session_delete) [list source [file join $dir session.tcl]]
>  set auto_index(session_list) [list source [file join $dir session.tcl]]
> +set auto_index(session_notice_file_change) [list source [file join $dir session.tcl]]
>  set auto_index(TdumpWin) [list source [file join $dir tdump.tcl]]
>  set auto_index(TfindArgs) [list source [file join $dir tfind_args.tcl]]
>  set auto_index(oldGDBToolBar) [list source [file join $dir toolbar.tcl]]

-- 
Fernando Nasser
Red Hat Canada Ltd.                     E-Mail:  fnasser@redhat.com
2323 Yonge Street, Suite #300
Toronto, Ontario   M4P 2C9