This is the mail archive of the
insight@sources.redhat.com
mailing list for the Insight project.
Re: Patch: session namespace
- From: Fernando Nasser <fnasser at redhat dot com>
- To: tromey at redhat dot com
- Cc: Insight List <insight at sources dot redhat dot com>
- Date: Mon, 18 Feb 2002 11:13:28 -0500
- Subject: Re: Patch: session namespace
- Organization: Red Hat Canada
- References: <87d6z3itps.fsf@creche.redhat.com>
Tom Tromey wrote:
>
> I thought I submitted this (actually I thought I submitted it twice),
> but I can't find it in the archives.
>
> 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?
>
> Tom
>
I have no objections.
Fernando
> 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]]
--
Fernando Nasser
Red Hat Canada Ltd. E-Mail: fnasser@redhat.com
2323 Yonge Street, Suite #300
Toronto, Ontario M4P 2C9