namespace eval Session {
namespace export save load notice_file_change delete list_names
proc _exe_name {path} {
global tcl_platform
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]]
}
proc _serialize_bps {} {
set result {}
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
if {$debugging_gdb} {
if {$function == "internal_error" || $function == "info_command"} {
continue
}
}
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 != ""} {
append cmd "$file:$line_number"
} else {
append cmd "*$address"
}
}
"watchpoint" -
"hw watchpoint" {
set cmd watch
if {$user_specification != ""} {
append cmd " $user_specification"
} else {
continue
}
}
"catch*" {
continue
}
default {
continue
}
}
lappend result [list $cmd $enabled $condition $command_list]
}
return $result
}
proc _recreate_bps {specs} {
foreach spec $specs {
lassign $spec create enabled condition commands
if {[catch {gdb_cmd $create} txt]} {
dbug W $txt
}
if {! $enabled} {
gdb_cmd "disable \$bpnum"
}
if {$condition != ""} {
gdb_cmd "cond \$bpnum $condition"
}
if {[llength $commands]} {
lappend commands end
eval gdb_run_readline_command_no_output [list "commands \$bpnum"] \
$commands
}
}
}
proc save {} {
global gdb_exe_name gdb_target_name
global gdb_current_directory gdb_source_path
set name [_exe_name $gdb_exe_name]
set key gdb/session/$name
set values(executable) $name
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
set values(hostname) [pref getd gdb/load/$gdb_target_name-hostname]
set values(port) [pref getd gdb/load/$gdb_target_name-portname]
set values(target_cmd) $::gdb_target_cmd
set values(bg) $::gdb_bg_num
set values(run_attach) [pref get gdb/src/run_attach]
set values(run_load) [pref get gdb/src/run_load]
set values(run_run) [pref get gdb/src/run_run]
set values(run_cont) [pref get gdb/src/run_cont]
set values(breakpoints) [_serialize_bps]
set recent [concat [list $name] \
[lremove [pref getd gdb/recent-projects] $name]]
if {[llength $recent] > 20} {
set recent [lreplace $recent 20 end]
}
pref setd gdb/recent-projects $recent
foreach k [array names values] {
pref setd $key/$k $values($k)
}
pref setd $key/all-keys [array names values]
}
proc load {name} {
set key gdb/session/$name
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
}
}
proc notice_file_change {} {
global gdb_exe_name gdb_target_name
debug "noticed file change event for $gdb_exe_name"
set name [_exe_name $gdb_exe_name]
set key gdb/session/$name
foreach k [pref getd $key/all-keys] {
set values($k) [pref getd $key/$k]
}
pref set gdb/src/run_attach 0
pref set gdb/src/run_load 0
pref set gdb/src/run_run 1
pref set gdb/src/run_cont 0
if {! [info exists values(executable)] || $values(executable) != $name} {
return
}
debug "reloading session for $name"
if {[info exists values(dirs)]} {
gdb_cmd "directory"
gdb_cmd "directory $values(dirs)"
}
if {[info exists values(pwd)]} {
catch {gdb_cmd "cd $values(pwd)"}
}
if {[info exists values(args)]} {
gdb_set_inferior_args $values(args)
}
if {[info exists values(breakpoints)]} {
_recreate_bps $values(breakpoints)
}
if {[info exists values(target)]} {
set gdb_target_name $values(target)
if {[info exists values(hostname)]} {
pref setd gdb/load/$gdb_target_name-hostname $values(hostname)
}
if {[info exists values(port)]} {
pref setd gdb/load/$gdb_target_name-portname $values(port)
}
set ::gdb_target_cmd $values(target_cmd)
set_baud
}
if {[info exists values(run_attach)]} {
pref set gdb/src/run_attach $values(run_attach)
pref set gdb/src/run_load $values(run_load)
pref set gdb/src/run_run $values(run_run)
pref set gdb/src/run_cont $values(run_cont)
}
if {[info exists values(bg)] && [pref get gdb/use_color_schemes]} {
set_bg_colors $values(bg)
}
}
proc delete {name} {
set recent [lremove [pref getd gdb/recent-projects] $name]
pref setd gdb/recent-projects $recent
}
proc list_names {} {
set newlist {}
set result {}
foreach name [pref getd gdb/recent-projects] {
set exe [pref getd gdb/session/$name/executable]
if {[file exists $exe]} then {
lappend newlist $name
lappend result $exe
} else {
}
}
pref setd gdb/recent-projects $newlist
return $result
}
}