Re: Patch: session namespace

[Keith Seitz <keiths at redhat dot com>]

On 17 Feb 2002, Tom Tromey wrote:

> I thought I submitted this (actually I thought I submitted it twice),
> but I can't find it in the archives.

I don't remember seeing it, but I'm getting forgetful in my old age...

> A long time ago I promised a patch to change the session code to use a
> namespace.  Here it is.  It seems big because of all the
> reindentation.  Ok to commit?

You bet! Thanks a lot!
Keith

> Index: ChangeLog
> from  Tom Tromey  <tromey@redhat.com>
>
> 	* library/tclIndex: Updated.
> 	* library/srcbar.itcl (SrcBar): Use new Session namespace.
> 	* library/main.tcl: Use new Session namespace.
> 	* library/interface.tcl (gdbtk_tcl_preloop): Use new Session
> 	namespace.
> 	(gdbtk_cleanup): Likewise.
> 	(_close_file): Likewise.
> 	* library/session.tcl: Use a namespace.  Renamed all functions.
>
> Index: library/interface.tcl
> ===================================================================
> RCS file: /cvs/src/src/gdb/gdbtk/library/interface.tcl,v
> retrieving revision 1.39
> diff -u -r1.39 interface.tcl
> --- library/interface.tcl 2002/01/08 19:34:48 1.39
> +++ library/interface.tcl 2002/01/18 18:19:56
> @@ -118,7 +118,7 @@
>      # arguments and pwd to override what is set in the session.
>      set current_args [gdb_get_inferior_args]
>      set current_dir $gdb_current_directory
> -    session_notice_file_change
> +    Session::notice_file_change
>      if {[string length $current_args] > 0} {
>        gdb_set_inferior_args $current_args
>        gdb_cmd "cd $current_dir"
> @@ -268,7 +268,7 @@
>
>    # Save the session
>    if {$gdb_exe_name != ""} {
> -    session_save
> +    Session::save
>    }
>
>    # This is a sign that it is too late to be doing updates, etc...
> @@ -971,7 +971,7 @@
>    }
>
>    if {$okay} {
> -    session_save
> +    Session::save
>      gdb_clear_file
>      gdbtk_tcl_file_changed ""
>
> Index: library/main.tcl
> ===================================================================
> RCS file: /cvs/src/src/gdb/gdbtk/library/main.tcl,v
> retrieving revision 1.7
> diff -u -r1.7 main.tcl
> --- library/main.tcl 2001/11/05 19:14:00 1.7
> +++ library/main.tcl 2002/01/18 18:19:56
> @@ -142,7 +142,7 @@
>  init_disassembly_flavor
>
>  # Arrange for session code to notice when file changes.
> -add_hook file_changed_hook session_notice_file_change
> +add_hook file_changed_hook Session::notice_file_change
>
>  ManagedWin::init
>
> Index: library/session.tcl
> ===================================================================
> RCS file: /cvs/src/src/gdb/gdbtk/library/session.tcl,v
> retrieving revision 1.10
> diff -u -r1.10 session.tcl
> --- library/session.tcl 2002/01/03 21:42:32 1.10
> +++ library/session.tcl 2002/01/18 18:19:56
> @@ -11,281 +11,285 @@
>  # 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 {} {
> -  set result {}
> -
> -  # HACK.  When debugging gdb with itself in the build
> -  # directory, there is a ".gdbinit" file that will set
> -  # breakpoints on internal_error() and info_command().
> -  # If we then save and set them, they will accumulate.
> -  # Possible fixes are to modify GDB so we can tell which
> -  # breakpoints were set from .gdbinit, or modify
> -  # SESSION_recreate_bps to record which breakpoints were
> -  # set before it was called.  For now, we simply detect the
> -  # most common case and fix it.
> -  set basename [string tolower [file tail $::gdb_exe_name]]
> -  if {[string match "gdb*" $basename]
> -      || [string match "insight*" $basename]} {
> -    set debugging_gdb 1
> -  } else {
> -    set debugging_gdb 0
> -  }
> -
> -  foreach bp_num [gdb_get_breakpoint_list] {
> -    lassign [gdb_get_breakpoint_info $bp_num] file function line_number \
> -      address type enabled disposition ignore_count command_list \
> -      condition thread hit_count user_specification
> -
> -    # These breakpoints are set when debugging GDB with itself.
> -    # Ignore them so they don't accumulate. They get set again
> -    # by .gdbinit anyway.
> -    if {$debugging_gdb} {
> -      if {$function == "internal_error" || $function == "info_command"} {
> -	continue
> -      }
> +namespace eval Session {
> +  namespace export save load notice_file_change delete list_names
> +
> +  # 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 _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 _serialize_bps {} {
> +    set result {}
> +
> +    # HACK.  When debugging gdb with itself in the build
> +    # directory, there is a ".gdbinit" file that will set
> +    # breakpoints on internal_error() and info_command().
> +    # If we then save and set them, they will accumulate.
> +    # Possible fixes are to modify GDB so we can tell which
> +    # breakpoints were set from .gdbinit, or modify
> +    # _recreate_bps to record which breakpoints were
> +    # set before it was called.  For now, we simply detect the
> +    # most common case and fix it.
> +    set basename [string tolower [file tail $::gdb_exe_name]]
> +    if {[string match "gdb*" $basename]
> +	|| [string match "insight*" $basename]} {
> +      set debugging_gdb 1
> +    } else {
> +      set debugging_gdb 0
>      }
>
> -    switch -glob -- $type {
> -      "breakpoint" -
> -      "hw breakpoint" {
> -	if {$disposition == "delete"} {
> -	  set cmd tbreak
> -	} else {
> -	  set cmd break
> -	}
> -
> -	append cmd " "
> -	if {$user_specification != ""} {
> -	  append cmd "$user_specification"
> -	} elseif {$file != ""} {
> -	  # BpWin::bp_store uses file tail here, but I think that is
> -	  # wrong.
> -	  append cmd "$file:$line_number"
> -	} else {
> -	  append cmd "*$address"
> +    foreach bp_num [gdb_get_breakpoint_list] {
> +      lassign [gdb_get_breakpoint_info $bp_num] file function line_number \
> +	address type enabled disposition ignore_count command_list \
> +	condition thread hit_count user_specification
> +
> +      # These breakpoints are set when debugging GDB with itself.
> +      # Ignore them so they don't accumulate. They get set again
> +      # by .gdbinit anyway.
> +      if {$debugging_gdb} {
> +	if {$function == "internal_error" || $function == "info_command"} {
> +	  continue
>  	}
>        }
> -      "watchpoint" -
> -      "hw watchpoint" {
> -	set cmd watch
> -	if {$user_specification != ""} {
> -	  append cmd " $user_specification"
> -	} else {
> -	  # There's nothing sensible to do.
> +
> +      switch -glob -- $type {
> +	"breakpoint" -
> +	"hw breakpoint" {
> +	  if {$disposition == "delete"} {
> +	    set cmd tbreak
> +	  } else {
> +	    set cmd break
> +	  }
> +
> +	  append cmd " "
> +	  if {$user_specification != ""} {
> +	    append cmd "$user_specification"
> +	  } elseif {$file != ""} {
> +	    # BpWin::bp_store uses file tail here, but I think that is
> +	    # wrong.
> +	    append cmd "$file:$line_number"
> +	  } else {
> +	    append cmd "*$address"
> +	  }
> +	}
> +	"watchpoint" -
> +	"hw watchpoint" {
> +	  set cmd watch
> +	  if {$user_specification != ""} {
> +	    append cmd " $user_specification"
> +	  } else {
> +	    # There's nothing sensible to do.
> +	    continue
> +	  }
> +	}
> +
> +	"catch*" {
> +	  # FIXME: Don't know what to do.
>  	  continue
>  	}
> -      }
>
> -      "catch*" {
> -	# FIXME: Don't know what to do.
> -	continue
> +	default {
> +	  # Can't serialize anything other than those listed above.
> +	  continue
> +	}
>        }
>
> -      default {
> -	# Can't serialize anything other than those listed above.
> -	continue
> -      }
> +      lappend result [list $cmd $enabled $condition $command_list]
>      }
> -
> -    lappend result [list $cmd $enabled $condition $command_list]
> +
> +    return $result
>    }
> -
> -  return $result
> -}
>
> -# An internal function used when loading sessions.  It takes a
> -# breakpoint string and recreates all the breakpoints.
> -proc SESSION_recreate_bps {specs} {
> -  foreach spec $specs {
> -    lassign $spec create enabled condition commands
> +  # An internal function used when loading sessions.  It takes a
> +  # breakpoint string and recreates all the breakpoints.
> +  proc _recreate_bps {specs} {
> +    foreach spec $specs {
> +      lassign $spec create enabled condition commands
>
> -    # Create the breakpoint
> -    gdb_cmd $create
> +      # Create the breakpoint
> +      gdb_cmd $create
>
> -    # Below we use `\$bpnum'.  This means we don't have to figure out
> -    # the number of the breakpoint when doing further manipulations.
> +      # Below we use `\$bpnum'.  This means we don't have to figure out
> +      # the number of the breakpoint when doing further manipulations.
>
> -    if {! $enabled} {
> -      gdb_cmd "disable \$bpnum"
> -    }
> +      if {! $enabled} {
> +	gdb_cmd "disable \$bpnum"
> +      }
>
> -    if {$condition != ""} {
> -      gdb_cmd "cond \$bpnum $condition"
> -    }
> +      if {$condition != ""} {
> +	gdb_cmd "cond \$bpnum $condition"
> +      }
>
> -    if {[llength $commands]} {
> -      lappend commands end
> -      eval gdb_run_readline_command_no_output [list "commands \$bpnum"] \
> -	$commands
> +      if {[llength $commands]} {
> +	lappend commands end
> +	eval gdb_run_readline_command_no_output [list "commands \$bpnum"] \
> +	  $commands
> +      }
>      }
>    }
> -}
> -
> -#
> -# This procedure decides what makes up a gdb `session'.  Roughly a
> -# session is whatever the user found useful when debugging a certain
> -# executable.
> -#
> -# Eventually we should expand this procedure to know how to save
> -# window placement and contents.  That requires more work.
> -#
> -proc session_save {} {
> -  global gdb_exe_name gdb_target_name
> -  global gdb_current_directory gdb_source_path
> -
> -  # gdb sessions are named after the executable.
> -  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.  Use the full path to the
> +  #
> +  # This procedure decides what makes up a gdb `session'.  Roughly a
> +  # session is whatever the user found useful when debugging a certain
>    # executable.
> -  set values(executable) $name
> -
> -  # Some simple state the user wants.
> -  set values(args) [gdb_get_inferior_args]
> -  set values(dirs) $gdb_source_path
> -  set values(pwd) $gdb_current_directory
> -  set values(target) $gdb_target_name
> -
> -  # Breakpoints.
> -  set values(breakpoints) [SESSION_serialize_bps]
> -
> -  # Recompute list of recent sessions.  Trim to no more than 5 sessions.
> -  set recent [concat [list $name] \
> -		[lremove [pref getd gdb/recent-projects] $name]]
> -  if {[llength $recent] > 5} then {
> -    set recent [lreplace $recent 5 end]
> -  }
> -  pref setd gdb/recent-projects $recent
> +  #
> +  # Eventually we should expand this procedure to know how to save
> +  # window placement and contents.  That requires more work.
> +  #
> +  proc save {} {
> +    global gdb_exe_name gdb_target_name
> +    global gdb_current_directory gdb_source_path
> +
> +    # gdb sessions are named after the executable.
> +    set name [_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.  Use the full path to the
> +    # executable.
> +    set values(executable) $name
> +
> +    # Some simple state the user wants.
> +    set values(args) [gdb_get_inferior_args]
> +    set values(dirs) $gdb_source_path
> +    set values(pwd) $gdb_current_directory
> +    set values(target) $gdb_target_name
> +
> +    # Breakpoints.
> +    set values(breakpoints) [_serialize_bps]
> +
> +    # Recompute list of recent sessions.  Trim to no more than 5 sessions.
> +    set recent [concat [list $name] \
> +		  [lremove [pref getd gdb/recent-projects] $name]]
> +    if {[llength $recent] > 5} then {
> +      set recent [lreplace $recent 5 end]
> +    }
> +    pref setd gdb/recent-projects $recent
>
> -  foreach k [array names values] {
> -    pref setd $key/$k $values($k)
> +    foreach k [array names values] {
> +      pref setd $key/$k $values($k)
> +    }
> +    pref setd $key/all-keys [array names values]
>    }
> -  pref setd $key/all-keys [array names values]
> -}
>
> -#
> -# Load a session saved with session_save.  NAME is the pretty name of
> -# the session, as returned by session_list.
> -#
> -proc session_load {name} {
> -  global gdb_target_name
> -
> -  # gdb sessions are named after the executable.
> -  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]
> -  }
> +  #
> +  # Load a session saved with Session::save.  NAME is the pretty name of
> +  # the session, as returned by Session::list_names.
> +  #
> +  proc load {name} {
> +    global gdb_target_name
> +
> +    # gdb sessions are named after the executable.
> +    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)]} {
> -    gdb_clear_file
> -    set_exe_name $values(executable)
> -    set_exe
> +    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]
> -  }
> +  #
> +  # 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 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 [_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
> -  }
> +    if {! [info exists values(executable)] || $values(executable) != $name} {
> +      # No such session.
> +      return
> +    }
>
> -  debug "reloading session for $gdb_exe_name"
> +    debug "reloading session for $gdb_exe_name"
>
> -  if {[info exists values(dirs)]} {
> -    # FIXME: short-circuit confirmation.
> -    gdb_cmd "directory"
> -    gdb_cmd "directory $values(dirs)"
> -  }
> +    if {[info exists values(dirs)]} {
> +      # FIXME: short-circuit confirmation.
> +      gdb_cmd "directory"
> +      gdb_cmd "directory $values(dirs)"
> +    }
>
> -  if {[info exists values(pwd)]} {
> -    gdb_cmd "cd $values(pwd)"
> -  }
> +    if {[info exists values(pwd)]} {
> +      gdb_cmd "cd $values(pwd)"
> +    }
>
> -  if {[info exists values(args)]} {
> -    gdb_set_inferior_args $values(args)
> -  }
> +    if {[info exists values(args)]} {
> +      gdb_set_inferior_args $values(args)
> +    }
>
> -  if {[info exists values(breakpoints)]} {
> -    SESSION_recreate_bps $values(breakpoints)
> -  }
> +    if {[info exists values(breakpoints)]} {
> +      _recreate_bps $values(breakpoints)
> +    }
>
> -  if {[info exists values(target)]} {
> -    debug "Restoring Target: $values(target)"
> -    set gdb_target_name $values(target)
> +    if {[info exists values(target)]} {
> +      debug "Restoring Target: $values(target)"
> +      set gdb_target_name $values(target)
> +    }
>    }
> -}
>
> -#
> -# Delete a session.  NAME is the internal name of the session.
> -#
> -proc session_delete {name} {
> -  # FIXME: we can't yet fully define this because the libgui
> -  # preference code doesn't supply a delete method.
> -  set recent [lremove [pref getd gdb/recent-projects] $name]
> -  pref setd gdb/recent-projects $recent
> -}
> -
> -#
> -# Return a list of all known sessions.  This returns the `pretty name'
> -# of the session -- something suitable for a menu.
> -#
> -proc session_list {} {
> -  set newlist {}
> -  set result {}
> -  foreach name [pref getd gdb/recent-projects] {
> -    set exe [pref getd gdb/session/$name/executable]
> -    # Take this opportunity to prune the list.
> -    if {[file exists $exe]} then {
> -      lappend newlist $name
> -      lappend result $exe
> -    } else {
> -      # FIXME: if we could delete keys we would delete all keys
> -      # associated with NAME now.
> +  #
> +  # Delete a session.  NAME is the internal name of the session.
> +  #
> +  proc delete {name} {
> +    # FIXME: we can't yet fully define this because the libgui
> +    # preference code doesn't supply a delete method.
> +    set recent [lremove [pref getd gdb/recent-projects] $name]
> +    pref setd gdb/recent-projects $recent
> +  }
> +
> +  #
> +  # Return a list of all known sessions.  This returns the `pretty name'
> +  # of the session -- something suitable for a menu.
> +  #
> +  proc list_names {} {
> +    set newlist {}
> +    set result {}
> +    foreach name [pref getd gdb/recent-projects] {
> +      set exe [pref getd gdb/session/$name/executable]
> +      # Take this opportunity to prune the list.
> +      if {[file exists $exe]} then {
> +	lappend newlist $name
> +	lappend result $exe
> +      } else {
> +	# FIXME: if we could delete keys we would delete all keys
> +	# associated with NAME now.
> +      }
>      }
> +    pref setd gdb/recent-projects $newlist
> +    return $result
>    }
> -  pref setd gdb/recent-projects $newlist
> -  return $result
>  }
> Index: library/srcbar.itcl
> ===================================================================
> RCS file: /cvs/src/src/gdb/gdbtk/library/srcbar.itcl,v
> retrieving revision 1.14
> diff -u -r1.14 srcbar.itcl
> --- library/srcbar.itcl 2002/01/07 08:58:47 1.14
> +++ library/srcbar.itcl 2002/01/18 18:19:56
> @@ -168,13 +168,13 @@
>      $Menu add command Other "Source..." \
>        "source_file" -underline 0
>
> -    set sessions [session_list]
> +    set sessions [Session::list_names]
>      if {[llength $sessions]} {
>        $Menu add separator
>        set i 1
>        foreach item $sessions {
>  	$Menu add command Other "$i $item" \
> -	  [list session_load $item] \
> +	  [list Session::load $item] \
>  	  -underline 0
>  	incr i
>        }
> Index: library/tclIndex
> ===================================================================
> RCS file: /cvs/src/src/gdb/gdbtk/library/tclIndex,v
> retrieving revision 1.21
> diff -u -r1.21 tclIndex
> --- library/tclIndex 2001/10/28 20:08:39 1.21
> +++ library/tclIndex 2002/01/18 18:19:57
> @@ -88,13 +88,11 @@
>  set auto_index(unescape_value) [list source [file join $dir prefs.tcl]]
>  set auto_index(pref_set_defaults) [list source [file join $dir prefs.tcl]]
>  set auto_index(pref_src-font_trace) [list source [file join $dir prefs.tcl]]
> -set auto_index(SESSION_serialize_bps) [list source [file join $dir session.tcl]]
> -set auto_index(SESSION_recreate_bps) [list source [file join $dir session.tcl]]
> -set auto_index(session_save) [list source [file join $dir session.tcl]]
> -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(Session::save) [list source [file join $dir session.tcl]]
> +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_names) [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]]
>