diff options
Diffstat (limited to 'gdb/gdbtk/library/srcwin.itb')
| -rw-r--r-- | gdb/gdbtk/library/srcwin.itb | 1051 |
1 files changed, 0 insertions, 1051 deletions
diff --git a/gdb/gdbtk/library/srcwin.itb b/gdb/gdbtk/library/srcwin.itb deleted file mode 100644 index c8b17dc8741..00000000000 --- a/gdb/gdbtk/library/srcwin.itb +++ /dev/null @@ -1,1051 +0,0 @@ -# Source window for Insight. -# Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004 Red Hat, Inc. -# -# This program is free software; you can redistribute it and/or modify it -# under the terms of the GNU General Public License (GPL) as published by -# the Free Software Foundation; either version 2 of the License, or (at -# your option) any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. - - -# ------------------------------------------------------------------ -# CONSTRUCTOR - create new source window -# ------------------------------------------------------------------ -itcl::body SrcWin::constructor {args} { - debug "$args" - eval itk_initialize $args - set top [winfo toplevel $itk_interior] - - _update_title "" - - set Tracing [pref get gdb/mode] - set current(filename) "" - - if {[catch {_build_win} mssg]} { - dbug E "_build_win returned: $::errorInfo" - } - - # add special delete handler - wm protocol $top WM_DELETE_WINDOW "[code $this _exit]" - - # add hooks - add_hook gdb_no_inferior_hook "$this no_inferior" - add_hook download_progress_hook "$this download_progress" - add_hook state_hook [code $this _set_state] - add_hook gdb_clear_file_hook [code $this clear_file] - after idle " - update idletasks - $this sizeWinByChild toolbar" - - lappend window_list $this -} - -# ------------------------------------------------------------------ -# DESTRUCTOR - destroy window containing widget -# ------------------------------------------------------------------ -itcl::body SrcWin::destructor {} { - debug - remove_hook gdb_no_inferior_hook "$this no_inferior" - remove_hook download_progress_hook "$this download_progress" - remove_hook state_hook [code $this _set_state] - remove_hook gdb_clear_file_hook [code $this clear_file] - set window_list [lremove $window_list $this] - if {$pc_window == $this} then { - set pc_window "" - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _build_win - build the main source window -# ------------------------------------------------------------------ -itcl::body SrcWin::_build_win {} { - global gdb_downloading gdb_running gdb_loaded - - # build source toolbar - set _toolbar [conAdd toolbar -resizable 0] - SrcBar $_toolbar $this \ - -updatecommand [list $this toggle_updates] \ - -updatevalue $do_updates - pack $_toolbar -expand 1 -fill both - - # if user likes control on bottom... - if {! [pref get gdb/src/top_control]} { - - # add a SrcTextWin container - set srcwin [conAdd src] - set twin [SrcTextWin $srcwin -Tracing $Tracing -parent $this] - pack $srcwin -expand 1 -fill both - - # add status line - set _status [conAdd status -resizable 0] - label $_status -relief sunken -bd 3 -font global/status -height 1 - pack $_status -expand 1 -fill both - } - - # add a status bar container - set _statbar [conAdd stat -resizable 0] - frame $_statbar - pack $_statbar -expand 1 -fill both - - combobox::combobox $_statbar.name -maxheight 15 -font global/fixed\ - -command [code $this _name] -bg $::Colors(textbg) - - set need_files 1 - - combobox::combobox $_statbar.func -maxheight 15 -font global/fixed\ - -command [code $this goto_func] -bg $::Colors(textbg) - combobox::combobox $_statbar.mode -width 9 -editable false \ - -font global/fixed -command [code $this mode] -bg $::Colors(textbg) - - $_statbar.mode list insert end SOURCE - $_statbar.mode list insert end ASSEMBLY - $_statbar.mode list insert end MIXED - $_statbar.mode list insert end SRC+ASM - - pack $_statbar.mode -side right -padx 10 -pady 4 - pack $_statbar.name $_statbar.func -side left -pady 4 -padx 10 - - # if user likes control on top... - if {[pref get gdb/src/top_control]} { - - # add a SrcTextWin container - set srcwin [conAdd src] - set twin [SrcTextWin $srcwin -Tracing $Tracing -parent $this] - pack $srcwin -expand 1 -fill both - - # add status line - set _status [conAdd status -resizable 0] - set _statusframe [frame $_status] - set _status $_statusframe.con - label $_status -relief sunken -bd 3 -font global/status -height 1 \ - -anchor w - - # add download progress meter - canvas $_statusframe.progress -relief sunken -borderwidth 2 \ - -highlightthickness 0 -takefocus 0 -width 100 -height 0 -confine 1 - $_statusframe.progress create rectangle 0 0 0 \ - [winfo height $_statusframe.progress] -outline blue -fill blue -tags rect - - # add address and line number indicators - label $_statusframe.addr -text "" -width 10 -relief sunken \ - -bd 1 -anchor e -font global/fixed - label $_statusframe.line -text "" -width 6 -relief sunken \ - -bd 1 -anchor e -font global/fixed - - balloon register $_statusframe.addr "Address" - balloon register $_statusframe.line "Line number" - - pack $_statusframe -expand 1 -fill both - grid $_status -row 0 -column 1 -sticky news -pady 2 -padx 2 - grid $_statusframe.addr -row 0 -column 3 -sticky nes -pady 4 - grid $_statusframe.line -row 0 -column 4 -sticky nws -pady 4 - grid columnconfigure $_statusframe 1 -weight 10 - grid columnconfigure $_statusframe 2 -minsize 5 - grid columnconfigure $_statusframe 5 -minsize 5 - } - - set_execution_status - - # balloon help - foreach i {entry button} { - balloon register $_statbar.name.$i "Current file name" - balloon register $_statbar.func.$i "Current function name" - balloon register $_statbar.mode.$i "Source mode" - } - balloon variable $_status ${twin}_balloon - - $_statbar.mode entryset [$twin mode_get] - - # time to load the widget with a file. - # If this is a new widget and the program is - # not yet being debugged, load the file with "main" in it. - if {$gdb_running} { - if {[catch {gdb_loc} loc]} { - # Nothing we can do but leave the window empty. - } else { - _update $loc - } - } -} - - -# ------------------------------------------------------------------ -# PUBLIC METHOD: _set_state - do things when program state changes -# ------------------------------------------------------------------ -itcl::body SrcWin::_set_state {varname} { - global gdb_running gdb_downloading gdb_loaded gdb_program_has_run - debug "$varname l=$gdb_loaded d=$gdb_downloading r=$gdb_running" - - if {$varname == "gdb_loaded" && $gdb_loaded == 1} { - set gdb_program_has_run 0 - #set current(filename) "" - return - } - - if {$gdb_running} { - set state normal - set gdb_program_has_run 1 - } else { - set state disabled - } - if {!$Tracing} { - $twin SetRunningState $state - } -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD: download_progress - update the progress meter when downloading -# ------------------------------------------------------------------ -itcl::body SrcWin::download_progress { section num tot {msg ""} } { - global download_start_time download_cancel_ok gdb_loaded - - #debug "$section $num $tot $msg" - if {$last_section_start == 0} { - grid forget $_statusframe.addr $_statusframe.line - grid $_statusframe.progress -row 0 -column 4 -padx 4 -sticky news - ::update idletasks - } - - if {$section == "DONE"} { - set last_done $tot - if {$gdb_loaded} { - # loaded something - set secs [expr {[clock seconds] - $download_start_time}] - if {$secs} { - set bps [expr {8 * $tot / $secs}] - set_status "DOWNLOAD FINISHED: $tot bytes in $secs seconds ($bps bits per second)" - } else { - set_status "DOWNLOAD FINISHED" - } - } - } elseif {$section != "CANCEL"} { - if {$section != $last_section} { - set last_section $section - set last_section_start $last_done - } - set last_done [expr {$last_section_start + $num}] - set_status "Downloading section $section - $num bytes" - } - - set canvas $_statusframe.progress - set height [winfo height $canvas] - if {$last_done} { - set width [winfo width $canvas] - set rw [expr {double ($last_done) * $width / $tot}] - $canvas coords rect 0 0 $rw $height - ::update - } - - if {$last_done == $tot || $section == "CANCEL"} { - $_toolbar configure -runstop normal - if {!$gdb_loaded} { - ::update - # errored or canceled - if {$msg != ""} { - set_status "DOWNLOAD FAILED: $msg" - } else { - set_status "DOWNLOAD CANCELLED" - } - $canvas coords rect 0 0 0 $height - ::update idletasks - } - - set last_section "" - set last_done 0 - set last_section_start 0 - - grid forget $_statusframe.progress - grid $_statusframe.addr -row 0 -column 3 -sticky new -pady 4 - grid $_statusframe.line -row 0 -column 4 -sticky nws -pady 4 - ::update idletasks - } -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD: reconfig - used when preferences change -# ------------------------------------------------------------------ -itcl::body SrcWin::reconfig {} { - debug - $_toolbar reconfig - $twin reconfig -} - - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _name - filename combobox callback -# This is only called when the user edits the name combobox. -# It is the only way that files can be inserted into the file list -# once the debugger is started. -# ------------------------------------------------------------------ -itcl::body SrcWin::_name {w {val ""}} { - global _files - debug "$w $val" - if {$val != ""} { - if {![info exists _files(short,$val)]} { - if {![info exists _files(full,$val)]} { - if [catch {gdb_find_file $val} full] { - set_status "Cannot find source file \"$val\": $full" - $_statbar.name entryset [lindex [file split $current(filename)] end] - return - } - if {$full == ""} { - set_status "Cannot find source file \"$val\"" - $_statbar.name entryset [lindex [file split $current(filename)] end] - return - } - set _files(short,$full) $val - set _files(full,$val) $full - } - set full $_files(full,$val) - } else { - set full $val - set val $_files(short,$full) - } - $_statbar.name entryset $val - location BROWSE_TAG [list $val "" $full 0 0 0 {}] - } -} - -# ------------------------------------------------------------------ -# PRIVATE PUBLIC METHOD: toggle_updates - update toggle callback -# ------------------------------------------------------------------ -itcl::body SrcWin::toggle_updates {value} { - # save state in do_updates so it will be preserved - # in window reconfigs - set do_updates $value -} - -# ------------------------------------------------------------------ -# PRIVATE PUBLIC METHOD: goto_func - function combobox callback -# ------------------------------------------------------------------ -itcl::body SrcWin::goto_func {w {val ""}} { - if {$val != ""} { - set mang 0 - if {[info exists _mangled_func($val)]} { - set mang $_mangled_func($val) - } - if {$mang} { - set loc $val - } else { - set fn [lindex [::file split $current(filename)] end] - if {$fn == ""} { - set loc $val - } else { - set loc $fn:$val - } - } - debug "GOTO $loc" - if {![catch {gdb_loc $loc} result]} { - location BROWSE_TAG $result - } else { - dbug W "gdb_loc returned \"$result\"" - } - } -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD: fillNameCB - fill the name combobox -# -# This method needs to be public, since other parts of -# the gui can cause new symbols to be read. -# ------------------------------------------------------------------ -itcl::body SrcWin::fillNameCB {} { - global _files - set allfiles [gdb_listfiles] - foreach f $allfiles { - # FIXME: If you reactivate this code add a catch as gdb_find_file can err - # (P.S.: I don't know why this is commented out) - #set fullname [gdb_find_file $f] - #set _files(full,$f) $fullname - #set _files(short,$fullname) $f - $_statbar.name list insert end $f - } - set need_files 0 -} - - -# ------------------------------------------------------------------ -# PUBLIC METHOD: fillFuncCB - fill the function combobox -# -# This method needs to be public, since other parts of -# the gui can cause new symbols to be read. -# ------------------------------------------------------------------ -itcl::body SrcWin::fillFuncCB {name} { - $_statbar.func list delete 0 end - if {$name != ""} { - set maxlen 10 - if {[catch {gdb_listfuncs $name} listfuncs]} { - tk_messageBox -icon error -default ok \ - -title "GDB" -type ok \ - -message "This file can not be found or does not contain\ndebugging information." - _set_name "" - return - } - foreach f [lsort -increasing $listfuncs] { - lassign $f func mang - set _mangled_func($func) $mang - $_statbar.func list insert end $func - if {[string length $func] > $maxlen} { - set maxlen [string length $func] - } - } - $_statbar.func configure -width [expr $maxlen + 1] - } -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD: location - update the location displayed -# -# a linespec looks like this: -# 0: basename of the file -# 1: function name -# 2: full filename -# 3: source line number -# 4: address -# 5: current PC - which will often be the same as address, but not when -# we are browsing, or walking the stack. -# 6: shared library name if the pc is in a shared lib -# -# linespec will be "{} {} {} 0 0x0 0x0" when GDB has not started debugging. -# ------------------------------------------------------------------ -itcl::body SrcWin::location {tag linespec} { - global gdb_running gdb_exe_name _files tcl_platform - - # We need to keep track of changes to the line, filename, function name - # and address so we can keep the widgets up-to-date. Otherwise we - # basically pass things through to the SrcTextWin location public method. - - debug "running=$gdb_running tag=$tag linespec=$linespec" - lassign $linespec foo funcname name line addr pc_addr lib - - # need to call this to update running state - set_execution_status $line $addr - - # "update" doesn't set the tag so we do it here - if {$tag == ""} { - if {$addr == $pc_addr} { - set tag PC_TAG - } else { - set tag STACK_TAG - } - } - - if {!$gdb_running} { - # When we are not yet debugging, we need to force something - # to be displayed, so we choose to find function "main" and - # display the file with it. - set tag BROWSE_TAG - debug "not running: name=$name funcname=$funcname line=$line" - if {$name == ""} { - if {[set linespec [gdbtk_locate_main]] == ""} { - # no "main" function found - return - } - lassign $linespec foo funcname name line addr pc_addr lib - debug "new linespec=$linespec" - } - } - - # update file and function combobox - if {$name != $current(filename)} { - _set_name $name - fillFuncCB $name - } - - # get a proper address string to display - set textaddr [gdb_CA_to_TAS $addr] - - # set address and line widgets - if {[string length $textaddr] > 8} { - # 64-bit address - set width 16 - } else { - # 32-bit address - set width 8 - } - $_statusframe.addr configure -text $textaddr -font global/fixed -width $width - $_statusframe.line configure -text $line - - # set function combobox - $_statbar.func entryset $funcname - - # call SrcTextWin::location - $twin location $tag $name $funcname $line $addr $pc_addr $lib - - set current(filename) $name -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD: stack - handle stack commands -# ------------------------------------------------------------------ -itcl::body SrcWin::stack {cmd} { - if {$cmd == "bottom"} { - set cmd "frame 0" - } - gdbtk_busy - if {[catch {gdb_cmd "$cmd"} message]} { - dbug E "STACK ERROR: $message" - } - gdbtk_update - gdbtk_idle -} - -# ------------------------------------------------------------------ -# METHOD: _update - update widget when PC changes -# ------------------------------------------------------------------ -itcl::body SrcWin::_update {loc} { - debug "loc=$loc" - # See if name combobox needs filled. - if {$need_files} { - fillNameCB - } - location "" $loc -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD: idle - callback for gdbtk_idle -# Called when the target is idle, so enable all buttons. -# ------------------------------------------------------------------ -itcl::body SrcWin::idle {event} { - $_toolbar configure -runstop normal - enable_ui 1 -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD: mode - set mode to SOURCE, ASSEMBLY, MIXED, SRC+ASM -# ------------------------------------------------------------------ -itcl::body SrcWin::mode {w new_mode {go 1}} { - gdbtk_busy - $_statbar.mode entryset $new_mode - catch {$twin mode_set $new_mode $go} errorVal - $_toolbar configure -displaymode $new_mode - gdbtk_idle -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _update_title - update title bar -# ------------------------------------------------------------------ -itcl::body SrcWin::_update_title {name} { - set fn [lindex [::file split $name] end] - if {$fn == ""} { - set prefix "" - } else { - set prefix "$fn - " - } - window_name "${prefix}Source Window" $fn -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD: busy - disable things when gdb is busy -# ------------------------------------------------------------------ -itcl::body SrcWin::busy {event} { - global gdb_loaded gdb_target_name -# debug "gdb_loaded=$gdb_loaded, gdb_target_name=$gdb_target_name" - - if {$do_updates} { - enable_ui 0 - if {$Running} { - $_toolbar configure -runstop running - if {$gdb_loaded || \ - ([TargetSelection::native_debugging] && $gdb_target_name != "remote")} { - set_status "Program is running." - } - } else { - $_toolbar configure -runstop busy - } - } -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD: update - The inferior's state has changed. -# ------------------------------------------------------------------ -itcl::body SrcWin::update {event} { - - # FIXME: This is kinda lame. We need to run this only once - # as it is now written, so only the first window in the list - # will actually call choose_and_update. - # This is still better than before, since it will not - # matter if this window is destroyed: as long as _a_ - # SrcWin exists, this will get called. - if {[lindex $window_list 0] == $this} { - choose_and_update - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _set_name - set the name in the name combobox and in the title -# ------------------------------------------------------------------ -itcl::body SrcWin::_set_name { val {found 1} } { - global _files - _update_title $val - if {![info exists _files(short,$val)]} { - if {![info exists _files(full,$val)]} { - # not in our list; just display basename - $_statbar.name entryset [lindex [::file split $val] end] - return - } - } else { - set val $_files(short,$val) - } - if {$found} { - $_statbar.name entryset $val - } else { - $_statbar.name entryset "$val (not found)" - } -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD: set_status - write a message to the status line. -# If "tmp" is set, the status change will not be saved. -# ------------------------------------------------------------------ - -itcl::body SrcWin::set_status { {msg ""} {tmp 0} } { - set msg [lindex [split $msg \n] 0] - if {$tmp} { - $_status configure -text $msg - return - } - if {$msg != ""} { - set saved_msg $msg - } - $_status configure -text $saved_msg -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD: set_execution_status - write the current execution state -# to the status line -# ------------------------------------------------------------------ -itcl::body SrcWin::set_execution_status { {line ""} {pc ""}} { - global gdb_running gdb_loaded gdb_program_has_run gdb_target_changed - #debug "line=$line pc=$pc [gdb_target_has_execution] running=$gdb_running loaded=$gdb_loaded" - set message "" - - if {![gdb_target_has_execution]} { - if {$gdb_running} { - set gdb_running 0 - # tell text window program is no longer running - $twin ClearTags - } - if {$gdb_loaded} { - if {$gdb_program_has_run} { - set message "Program terminated. 'Run' will restart." - # Need to set gdb_target_changed because most - # remote targets detach when they are finished, - # and this will force it to reattach. - set gdb_target_changed 1 - set gdb_running 0 - } else { - set message "Program is ready to run." - } - } else { - set message "Program not running. Click on run icon to start." - } - } else { - - # gdb_target_has_execution has returned true, so we must be running. - # - # This can cause problems on targets which do not set inferior_pid. - # Although this is bogus, much of gdb (and gdbtk) relies on - # gdb_target_has_execution (and thus inferior_pid), so we should - # not try to second guess it and fix those targets which do not set - # inferior_pid when opened. - set gdb_running 1 - - # only do a gdb_loc if we have to - if {$line == "" && $pc == ""} { - if {[catch {gdb_loc} loc] == 0} { - set line [lindex $loc 3] - set pc [lindex $loc 4] - } - } - - set pc [gdb_CA_to_TAS $pc] - - if {$line == "" || $line == 0} { - if {$pc == "" || $pc == 0} { - if {$Tracing} { - set message "Ready." - } else { - set message "Program stopped." - } - } else { - set message "Program stopped at 0x$pc" - } - } else { - if {$Tracing} { - set msg "Inspecting trace" - } else { - set msg "Program stopped" - } - switch [$twin mode_get] { - ASSEMBLY {set message "$msg at 0x$pc" } - MIXED {set message "$msg at line $line, 0x$pc" } - SRC+ASM {set message "$msg at line $line, 0x$pc" } - default {set message "$msg at line $line" } - } - } - } - set_status $message -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD: edit - invoke external editor -# ------------------------------------------------------------------ -itcl::body SrcWin::edit {} { - global external_editor_command - # If external editor is enabled, pass the file to the specified command - - if {$current(filename) == ""} { - tk_dialog .warn {Edit} {No file is loaded in the source window.} error 0 Ok - return - } - - if {[catch {$twin report_source_location} loc_info]} { - tk_dialog .warn "Edit" "No source file selected" error 0 Ok - return - } - - Editor::edit $loc_info -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD: print - print the contents of the text widget -# ------------------------------------------------------------------ -itcl::body SrcWin::print {} { - # Call the SrcTextWin's print public method - $twin print $top -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD: enable_ui -# Enable all UI elements for user interaction. -# ------------------------------------------------------------------ -itcl::body SrcWin::enable_ui { on } { - #debug "$on" - if {$on} { - set Running 0 - set state normal - set glyph "" - } else { - if {!$NoRun} {set Running 1} - set state disabled - set glyph watch - } - # combo boxes - $_statbar.mode configure -state $state - $_statbar.name configure -state $state - $_statbar.func configure -state $state - - $twin enable $on - $top configure -cursor $glyph -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD: no_inferior -# Put the UI elements of this object into a state -# appropriate for an inferior which is not executing. -# For this object, this means: -# Disable: -# - key binding for all inferior control (not needed -- gdb does this -# for us) -# -# Enable: -# - file/func/mode selectors -# - right-click popups, since gdb DOES allow looking at exe fil -# - selections -# -# Change mouse pointer to normal -# ------------------------------------------------------------------ -itcl::body SrcWin::no_inferior {} { - #debug - set_execution_status - enable_ui 1 -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD: reset - reset the source window -# ------------------------------------------------------------------ -itcl::body SrcWin::reset {} { - set current(filename) "" - set need_files 1 - set do_updates 1 - set last_section "" - set last_section_start 0 - set last_done 0 - set saved_msg "" - - # do we need to flush the cache or clear the source windows? - - # Empty combo boxes - $_statbar.name list delete 0 end - $_statbar.name configure -value {} - $_statbar.func list delete 0 end - $_statbar.func configure -value {} -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD: search - search for a STRING or jump to a specific line -# in source window, going in the specified DIRECTION. -# ------------------------------------------------------------------ -itcl::body SrcWin::search {direction string} { - set_status - set_status [$twin search $string $direction] 1 -} - -# ------------------------------------------------------------------ -# PROCEDURE: point_to_main -# Proc that may be called to point some source window to -# main (or an entry point?). (see gdbtk_tcl_exec_file_changed) -# ------------------------------------------------------------------ -itcl::body SrcWin::point_to_main {} { - # We need to force this to some default location. Assume main and - # if that fails, let the source window guess (via gdb_loc using stop_pc). - set src [lindex [ManagedWin::find SrcWin] 0] - if {[set linespec [gdbtk_locate_main]] == ""} { - gdbtk_update - debug "could not find main" - } else { - $src location BROWSE_TAG [list $linespec] - } -} - -itcl::body SrcWin::_exit {} { - debug - if {[llength [ManagedWin::find SrcWin]] == 1} { - if {![gdbtk_quit_check]} { - return - } - } - after idle [delete object $this] -} - -# public method for testing use only! -itcl::body SrcWin::test_get {var {private_func 0}} { - debug $var - if {$private_func} { - return [code $this $var] - } - return [set $var] -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD: toolbar - configure the toolbar's "state" -# ------------------------------------------------------------------ -# -# This method is used to configure the toolbar's running state. -# Valid states include anything that the "runtest" variable of -# the GDBSrcBar may accept. Specifically, -# -# busy - Run button becomes disabled -# running - Stop button appears, allowing user to stop executing target -# downloading - Stop button appears, allowing user to interrupt downloading -# normal - Run button appears, allowing user to run/re-run exe -itcl::body SrcWin::toolbar {state} { - $_toolbar configure -runstop $state -} - -# ------------------------------------------------------------------ -# METHOD: inferior - change execution state of inferior -# ------------------------------------------------------------------ -# -# ACTION may be: -# step - step the inferior one source line (stepping into functions) -# next - step the inferior one source line (stepping over functions) -# finish - finish the current frame of execution -# continue - continue executing the inferior -# stepi - step one machine instruction (stepping into calls) -# nexti - step one machine instruction (stepping over calls) -# run - run/re-run the inferior -# stop - stop or detach from target -# -# FIXME: This should really be in an object which describes gdb's state. -# Unfortunately, this doesn't exist, so it's here for now. -itcl::body SrcWin::inferior {action} { - - # Check to see if this action is forwarded to other Insight instances - if {$::iipc} { - switch $action { - step - - next - - stepi - - nexti - - finish { - if {[pref get gdb/ipc/step_button]} { - $::insight_ipc send $action - } - } - continue { - if {[pref get gdb/ipc/cont_button]} { - $::insight_ipc send $action - } - } - run { - if {[pref get gdb/ipc/run_button]} { - $::insight_ipc send $action - } - } - stop { - if {[pref get gdb/ipc/stop_button]} { - $::insight_ipc send $action - } - } - } - } - - switch $action { - step { gdbtk_step } - next { gdbtk_next } - finish { gdbtk_finish } - continue { gdbtk_continue } - stepi { gdbtk_stepi } - nexti { gdbtk_nexti } - run { gdbtk_run } - stop { gdbtk_stop } - } -} - -# ------------------------------------------------------------------ -# METHOD: clear_file -# Tasks for SrcWin to clear file: -# -# - clear window -# - reset to src mode -# - clear func/file comboboxes -# - clear status (done by no_inferior) -# - allow SrcTextWin to clear_file -# ------------------------------------------------------------------ -itcl::body SrcWin::clear_file {} { - - # Reset to Source mode - if {[$twin mode_get] != "SOURCE"} { - mode {} SOURCE 0 - } - - no_inferior - reset - - # run srctextwin clear_file - $twin clear_file -} - -# ------------------------------------------------------------------ -# METHOD: get_file -# Return name of displayed file, or empty string if no file. -# ------------------------------------------------------------------ -itcl::body SrcWin::get_file {} { - if {$twin == ""} { - return "" - } else { - return [$twin get_file] - } -} - -# ------------------------------------------------------------------ -# METHOD: is_fixed -# Return boolean indicating whether this window is fixed. -# ------------------------------------------------------------------ -itcl::body SrcWin::is_fixed {} { - return 0 -} - -# ------------------------------------------------------------------ -# METHOD: get_top -# Return toplevel -# ------------------------------------------------------------------ -itcl::body SrcWin::get_top {} { - return $top -} - -# ------------------------------------------------------------------ -# METHOD: _set_tag_to_stack -# Set tag to `stack' and update the underlying window. -# ------------------------------------------------------------------ -itcl::body SrcWin::_set_tag_to_stack {} { - set tag STACK_TAG - if {$twin != ""} then { - $twin set_tag_to_stack - } -} - -# ------------------------------------------------------------------ -# METHOD: _choose_window -# Choose the right source window. -# ------------------------------------------------------------------ -itcl::body SrcWin::_choose_window {file} { - # Find the next available source window. The rules are: - # 1. LRU overall - # 2. Skip iconified windows - # 3. If a window already shows the file, use it. Prefer the - # window currently showing the PC - # 4. If the window is fixed, skip it - if {$pc_window != ""} then { - if {[$pc_window get_file] == $file} then { - return $pc_window - } - } - - set choice "" - foreach win $window_list { - if {[wm state [$win get_top]] != "normal"} then { - continue - } - - if {[$win get_file] == "" - || [$win get_file] == $file - || ! [$win is_fixed]} then { - set choice $win - break - } - } - - # If we didn't find an available window, then pick the current PC - # window. - if {$choice == ""} then { - set choice $pc_window - } - - set window_list [lremove $window_list $choice] - lappend window_list $choice - - return $choice -} - -# ------------------------------------------------------------------ -# METHOD: choose_and_update -# Choose the right source window and then cause it to be updated -# ------------------------------------------------------------------ -itcl::body SrcWin::choose_and_update {} { - if {$pc_window == ""} then { - set pc_window [lindex $window_list 0] - } - - if {$pc_window == ""} then { - # Nothing. - } elseif {[catch {gdb_loc} loc]} { - $pc_window set_execution_status - } else { - set prev $pc_window - set file [lindex $loc 2] - set pc_window [_choose_window $file] - debug "chose window $pc_window" - $pc_window _update $loc - if {$pc_window != $prev} then { - $pc_window reveal - $prev _set_tag_to_stack - } - } -} - -# ------------------------------------------------------------------ -# METHOD: choose_and_display -# Choose the right source window for a given file -# ------------------------------------------------------------------ -itcl::body SrcWin::choose_and_display {tag linespec} { - set file [lindex $linespec 2] - set window [_choose_window $file] - $window location $tag $linespec -} |