Re: Patch: session startup patch

[Fernando Nasser <fnasser at redhat dot com>]

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