# Source window for Insight. # Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, # 2006 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 # Workaround: the three comboboxes above sometimes display with # height of one pixel. Inserting an invisible frame with the required # height "fixes" this... frame $_statbar.strut -height 24 -width 10 pack $_statbar.mode -side right -padx 10 -pady 4 pack $_statbar.name $_statbar.func $_statbar.strut \ -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 -unique $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} { after idle [emu_tigcc_close_debugger] 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 }