This is the mail archive of the
insight@sources.redhat.com
mailing list for the Insight project.
Patch: session namespace
- From: Tom Tromey <tromey at redhat dot com>
- To: Insight List <insight at sources dot redhat dot com>
- Date: 17 Feb 2002 16:17:35 -0700
- Subject: Patch: session namespace
- Reply-to: tromey at redhat dot com
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
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]]