# GDB GUI setup set cfile Blank set wins($cfile) .text set current_label {} set screen_height 0 set screen_top 0 set screen_bot 0 proc test {} { update_listing {termcap.c foo /etc/termcap 200} } proc echo string {puts stdout $string} proc gdbtk_tcl_fputs {arg} { .command.text insert end "$arg" .command.text yview -pickplace end } proc gdbtk_tcl_flush {} {update idletasks} proc gdbtk_tcl_query {message} { tk_dialog .query "gdb : query" "$message" {} 1 "No" "Yes" } if [info exists env(EDITOR)] then { set editor $env(EDITOR) } else { set editor emacs } proc gdbtk_tcl_start_variable_annotation {valaddr ref_type stor_cl cum_expr field type_cast} { echo "gdbtk_tcl_start_variable_annotation $valaddr $ref_type $stor_cl $cum_expr $field $type_cast" } proc gdbtk_tcl_end_variable_annotation {} { echo gdbtk_tcl_end_variable_annotation } proc insert_breakpoint_tag {win line} { $win configure -state normal $win delete $line.0 $win insert $line.0 "B" $win tag add $line $line.0 $win tag bind $line <1> { # echo "tag %W %X %Y %x" # echo "tag names [$wins($cfile) tag names]" } $win configure -state disabled } proc delete_breakpoint_tag {win line} { $win configure -state normal $win delete $line.0 $win insert $line.0 " " $win tag delete $line $win configure -state disabled } # Callback from GDB to notify us of breakpoint creation. proc create_breakpoint {bpnum file line} { global wins global breakpoint_file global breakpoint_line # Record breakpoint locations set breakpoint_file($bpnum) $file set breakpoint_line($bpnum) $line # If there isn't a window for this file, don't try to update it if [info exists wins($file)] { insert_breakpoint_tag $wins($file) $line } } proc delete_breakpoint {bpnum file line} { global wins global breakpoint_file global breakpoint_line # Save line number for later set line $breakpoint_line($bpnum) # Reset breakpoint annotation info unset breakpoint_file($bpnum) unset breakpoint_line($bpnum) # If there isn't a window for this file, don't try to update it if [info exists wins($file)] { delete_breakpoint_tag $wins($file) $line } } # This is a callback from C code to notify us of breakpoint changes. ACTION # can be one of create, delete, enable, or disable. proc gdbtk_tcl_breakpoint {action bpnum file line} { ${action}_breakpoint $bpnum $file $line } # Create the popup listing window menu menu .breakpoint -cursor hand2 .breakpoint add command -label Break .breakpoint add separator .breakpoint add command -label "Edit" -command {exec $editor +$selected_line $selected_file &} .breakpoint add command -label "Set breakpoint" -command {gdb_cmd "break $selected_file:$selected_line"} #.breakpoint add command -label "Clear breakpoint" -command {echo "Clear"} #.breakpoint add command -label "Enable breakpoint" -command {echo "Enable"} #.breakpoint add command -label "Disable breakpoint" -command {echo "Disable"} # Come here when button is released in the popup menu bind .breakpoint <Any-ButtonRelease-1> { global selected_win # First, remove the menu, and release the pointer .breakpoint unpost grab release .breakpoint # Unhighlight the selected line $selected_win tag delete breaktag # echo "after deleting $selected_win [$selected_win tag names]" # echo "grab [grab current]" # Actually invoke the menubutton here! tk_invokeMenu %W # destroy .breakpoint grab release $selected_win } # Button 1 has been pressed in a listing window. Pop up a menu. proc breakpoint_menu {win x y xrel yrel} { global wins global win_to_file global file_to_debug_file global highlight global selected_line global selected_file global selected_win grab $win # echo "bpm grab current [grab current]" # Map TK window name back to file name. set file $win_to_file($win) set pos [$win index @$xrel,$yrel] # Record selected file and line for menu button actions set selected_file $file_to_debug_file($file) set selected_line [lindex [split $pos .] 0] set selected_win $win # Highlight the selected line eval $win tag config breaktag $highlight $win tag add breaktag "$pos linestart" "$pos linestart + 1l" # Post the menu near the pointer, (and grab it) .breakpoint post [expr $x-[winfo width .breakpoint]/2] [expr $y-10] grab .breakpoint # echo "after grab [grab current]" } proc do_nothing {} {} proc create_file_win {filename} { global breakpoint_file global breakpoint_line regsub -all {\.|/} $filename {} temp set win .text$temp text $win -height 25 -width 80 -relief raised -borderwidth 2 -yscrollcommand textscrollproc -setgrid true -cursor hand2 bind $win <Enter> {focus %W} # bind $win <1> {breakpoint_menu %W %X %Y %x %y} bind $win <B1-Motion> do_nothing bind $win n {gdb_cmd next ; update_ptr} bind $win s {gdb_cmd step ; update_ptr} bind $win c {gdb_cmd continue ; update_ptr} bind $win f {gdb_cmd finish ; update_ptr} bind $win u {gdb_cmd up ; update_ptr} bind $win d {gdb_cmd down ; update_ptr} set fh [open $filename] $win delete 0.0 end $win insert 0.0 [read $fh] close $fh set numlines [$win index end] set numlines [lindex [split $numlines .] 0] for {set i 1} {$i <= $numlines} {incr i} { $win insert $i.0 [format " %4d " $i] } $win tag add wholebuf 0.0 end $win tag bind wholebuf <1> {breakpoint_menu %W %X %Y %x %y} foreach bpnum [array names breakpoint_file] { if {$breakpoint_file($bpnum) == $filename} { insert_breakpoint_tag $win $breakpoint_line($bpnum) } } $win configure -state disabled return $win } proc update_listing {linespec} { global pointers global screen_height global screen_top global screen_bot global wins cfile global current_label global win_to_file global file_to_debug_file set line [lindex $linespec 3] set filename [lindex $linespec 2] set funcname [lindex $linespec 1] set debug_file [lindex $linespec 0] if {$filename == ""} {set filename Blank} if {$filename != $cfile} then { pack forget $wins($cfile) set cfile $filename if ![info exists wins($cfile)] then { set wins($cfile) [create_file_win $cfile] set win_to_file($wins($cfile)) $cfile set file_to_debug_file($cfile) $debug_file set pointers($cfile) 1.1 } pack $wins($cfile) -side left -expand yes -in .listing -fill both -after .label $wins($cfile) yview [expr $line - $screen_height / 2] } if {$current_label != "$filename.$funcname"} then { set tail [expr [string last / $filename] + 1] .label configure -text "[string range $filename $tail end] : ${funcname}()" set current_label $filename.$funcname } if [info exists pointers($cfile)] then { $wins($cfile) configure -state normal set pointer_pos $pointers($cfile) $wins($cfile) configure -state normal $wins($cfile) delete $pointer_pos $wins($cfile) insert $pointer_pos " " set pointer_pos [$wins($cfile) index $line.1] set pointers($cfile) $pointer_pos $wins($cfile) delete $pointer_pos $wins($cfile) insert $pointer_pos "\xbb" if {$line < $screen_top + 1 || $line > $screen_bot} then { $wins($cfile) yview [expr $line - $screen_height / 2] } $wins($cfile) configure -state disabled } } proc update_ptr {} {update_listing [gdb_loc]} # Setup listing window frame .listing wm minsize . 1 1 label .label -text "*No file*" -borderwidth 2 -relief raised text $wins($cfile) -height 25 -width 80 -relief raised -borderwidth 2 -yscrollcommand textscrollproc -setgrid true -cursor hand2 scrollbar .scroll -orient vertical -command {$wins($cfile) yview} if {[tk colormodel .text] == "color"} { set highlight "-background red2 -borderwidth 2 -relief sunk" } else { set fg [lindex [.text config -foreground] 4] set bg [lindex [.text config -background] 4] set highlight "-foreground $bg -background $fg -borderwidth 0" } proc textscrollproc {args} {global screen_height screen_top screen_bot eval ".scroll set $args" set screen_height [lindex $args 1] set screen_top [lindex $args 2] set screen_bot [lindex $args 3]} $wins($cfile) insert 0.0 " This page intentionally left blank." $wins($cfile) configure -state disabled pack .label -side bottom -fill x -in .listing pack $wins($cfile) -side left -expand yes -in .listing -fill both pack .scroll -side left -fill y -in .listing button .start -text Start -command \ {gdb_cmd {break main} gdb_cmd {enable delete $bpnum} gdb_cmd run update_ptr } button .step -text Step -command {gdb_cmd step ; update_ptr} button .next -text Next -command {gdb_cmd next ; update_ptr} button .continue -text Continue -command {gdb_cmd continue ; update_ptr} button .finish -text Finish -command {gdb_cmd finish ; update_ptr} #button .test -text Test -command {echo [info var]} button .exit -text Exit -command {gdb_cmd quit} button .up -text Up -command {gdb_cmd up ; update_ptr} button .down -text Down -command {gdb_cmd down ; update_ptr} button .bottom -text "Bottom" -command {gdb_cmd {frame 0} ; update_ptr} proc files_command {} { toplevel .files_window wm minsize .files_window 1 1 # wm overrideredirect .files_window true listbox .files_window.list -geometry 30x20 -setgrid true button .files_window.close -text Close -command {destroy .files_window} tk_listboxSingleSelect .files_window.list eval .files_window.list insert 0 [lsort [gdb_listfiles]] pack .files_window.list -side top -fill both -expand yes pack .files_window.close -side bottom -fill x -expand no -anchor s bind .files_window.list <Any-ButtonRelease-1> { set file [%W get [%W curselection]] gdb_cmd "list $file:1,0" update_listing [gdb_loc $file:1] destroy .files_window} } button .files -text Files -command files_command pack .listing -side bottom -fill both -expand yes #pack .test -side bottom -fill x pack .start .step .next .continue .finish .up .down .bottom .files .exit -side left toplevel .command # Setup command window label .command.label -text "* Command Buffer *" -borderwidth 2 -relief raised text .command.text -height 25 -width 80 -relief raised -borderwidth 2 -setgrid true -cursor hand2 pack .command.label -side top -fill x pack .command.text -side top -expand yes -fill both set command_line {} gdb_cmd {set language c} gdb_cmd {set height 0} gdb_cmd {set width 0} bind .command.text <Any-Key> { global command_line %W insert end %A %W yview -pickplace end append command_line %A } bind .command.text <Key-Return> { global command_line %W insert end \n %W yview -pickplace end gdb_cmd $command_line set command_line {} update_ptr %W insert end "(gdb) " %W yview -pickplace end } bind .command.text <Enter> {focus %W} bind .command.text <Delete> {delete_char %W} bind .command.text <BackSpace> {delete_char %W} proc delete_char {win} { global command_line tk_textBackspace $win $win yview -pickplace insert set tmp [expr [string length $command_line] - 2] set command_line [string range $command_line 0 $tmp] } wm minsize .command 1 1