set screen_height 0
set screen_top 0
set screen_bot 0
-set current_output_win .cmd.text
set cfunc NIL
set line_numbers 1
set breakpoint_file(-1) {[garbage]}
#
proc gdbtk_tcl_fputs {arg} {
- global current_output_win
-
- $current_output_win insert end "$arg"
- $current_output_win yview -pickplace end
+ .cmd.text insert end "$arg"
+ .cmd.text yview -pickplace end
}
proc gdbtk_tcl_fputs_error {arg} {
#
proc gdbtk_tcl_flush {} {
- global current_output_win
-
- $current_output_win yview -pickplace end
+ .cmd.text yview -pickplace end
update idletasks
}
# of:
# create - Notify of breakpoint creation
# delete - Notify of breakpoint deletion
-# enable - Notify of breakpoint enabling
-# disable - Notify of breakpoint disabling
-#
-# All actions take the same set of arguments: BPNUM is the breakpoint
-# number, FILE is the source file and LINE is the line number, and PC is
-# the pc of the affected breakpoint.
+# modify - Notify of breakpoint modification
#
-proc gdbtk_tcl_breakpoint {action bpnum file line pc} {
+# file line pc type enabled disposition silent ignore_count commands cond_string thread hit_count
+
+proc gdbtk_tcl_breakpoint {action bpnum} {
+ set bpinfo [gdb_get_breakpoint_info $bpnum]
+ set file [lindex $bpinfo 0]
+ set line [lindex $bpinfo 1]
+ set pc [lindex $bpinfo 2]
+ set enable [lindex $bpinfo 4]
+
+ if {$action == "modify"} {
+ if {$enable == "enabled"} {
+ set action enable
+ } else {
+ set action disable
+ }
+ }
+
${action}_breakpoint $bpnum $file $line $pc
}
+proc create_breakpoints_window {} {
+ global bpframe_lasty
+
+ if [winfo exists .breakpoints] {raise .breakpoints ; return}
+
+ build_framework .breakpoints "Breakpoints" ""
+
+# First, delete all the old view menu entries
+
+ .breakpoints.menubar.view.menu delete 0 last
+
+# Get rid of label
+
+ destroy .breakpoints.label
+
+# Replace text with a canvas and fix the scrollbars
+
+ destroy .breakpoints.text
+ canvas .breakpoints.c -relief sunken -bd 2 \
+ -cursor hand2 -yscrollcommand {.breakpoints.scroll set}
+ .breakpoints.scroll configure -command {.breakpoints.c yview}
+ scrollbar .breakpoints.scrollx -orient horizontal \
+ -command {.breakpoints.c xview} -relief sunken
+
+ pack .breakpoints.scrollx -side bottom -fill x -in .breakpoints.info
+ pack .breakpoints.c -side left -expand yes -fill both \
+ -in .breakpoints.info
+
+ set bpframe_lasty 0
+
+# Create a frame for each breakpoint
+
+ foreach bpnum [gdb_get_breakpoint_list] {
+ add_breakpoint_frame $bpnum
+ }
+}
+
+# Create a frame for bpnum in the .breakpoints canvas
+
+proc add_breakpoint_frame bpnum {
+ global bpframe_lasty
+
+ if ![winfo exists .breakpoints] return
+
+ set bpinfo [gdb_get_breakpoint_info $bpnum]
+
+ set file [lindex $bpinfo 0]
+ set line [lindex $bpinfo 1]
+ set pc [lindex $bpinfo 2]
+ set type [lindex $bpinfo 3]
+ set enabled [lindex $bpinfo 4]
+ set disposition [lindex $bpinfo 5]
+ set silent [lindex $bpinfo 6]
+ set ignore_count [lindex $bpinfo 7]
+ set commands [lindex $bpinfo 8]
+ set cond [lindex $bpinfo 9]
+ set thread [lindex $bpinfo 10]
+ set hit_count [lindex $bpinfo 11]
+
+ set f .breakpoints.c.$bpnum
+
+ if ![winfo exists $f] {
+ frame $f -relief sunken -bd 2
+
+ label $f.id -text "#$bpnum $file:$line ($pc)" \
+ -relief flat -bd 2 -anchor w
+ frame $f.hit_count
+ label $f.hit_count.label -text "Hit count:" -relief flat \
+ -bd 2 -anchor w -width 11
+ label $f.hit_count.val -text $hit_count -relief flat \
+ -bd 2 -anchor w
+ checkbutton $f.hit_count.enabled -text Enabled \
+ -variable enabled -anchor w -relief flat
+ pack $f.hit_count.label $f.hit_count.val -side left
+ pack $f.hit_count.enabled -side right
+
+ frame $f.thread
+ label $f.thread.label -text "Thread: " -relief flat -bd 2 \
+ -width 11 -anchor w
+ entry $f.thread.entry -bd 2 -relief sunken -width 10
+ $f.thread.entry insert end $thread
+ pack $f.thread.label -side left
+ pack $f.thread.entry -side left -fill x
+
+ frame $f.cond
+ label $f.cond.label -text "Condition: " -relief flat -bd 2 \
+ -width 11 -anchor w
+ entry $f.cond.entry -bd 2 -relief sunken
+ $f.cond.entry insert end $cond
+ pack $f.cond.label -side left
+ pack $f.cond.entry -side left -fill x -expand yes
+
+ frame $f.ignore_count
+ label $f.ignore_count.label -text "Ignore count: " \
+ -relief flat -bd 2 -width 11 -anchor w
+ entry $f.ignore_count.entry -bd 2 -relief sunken -width 10
+ $f.ignore_count.entry insert end $ignore_count
+ pack $f.ignore_count.label -side left
+ pack $f.ignore_count.entry -side left -fill x
+
+ frame $f.disps
+
+ label $f.disps.label -text "Disposition: " -relief flat -bd 2 \
+ -anchor w -width 11
+
+ radiobutton $f.disps.delete -text Delete \
+ -variable disposition -anchor w -relief flat
+
+ radiobutton $f.disps.disable -text Disable \
+ -variable disposition -anchor w -relief flat
+
+ radiobutton $f.disps.donttouch -text "Leave alone" \
+ -variable disposition -anchor w -relief flat
+
+ pack $f.disps.label $f.disps.delete $f.disps.disable \
+ $f.disps.donttouch -side left -anchor w
+ text $f.commands -relief sunken -bd 2 -setgrid true \
+ -cursor hand2 -height 3 -width 30
+
+ foreach line $commands {
+ $f.commands insert end "${line}\n"
+ }
+
+ pack $f.id -side top -anchor nw -fill x
+ pack $f.hit_count $f.cond $f.thread $f.ignore_count $f.disps \
+ $f.commands -side top -fill x -anchor nw
+ }
+
+ set tag [.breakpoints.c create window 0 $bpframe_lasty -window $f -anchor nw]
+ update
+ set bbox [.breakpoints.c bbox $tag]
+
+ set bpframe_lasty [lindex $bbox 3]
+
+ .breakpoints.c configure -width [lindex $bbox 2]
+}
+
+# Delete a breakpoint frame
+
+proc delete_breakpoint_frame bpnum {
+ global bpframe_lasty
+
+ if ![winfo exists .breakpoints] return
+
+# First, clear the canvas
+
+ .breakpoints.c delete all
+
+# Now, repopulate it with all but the doomed breakpoint
+
+ set bpframe_lasty 0
+ foreach bp [gdb_get_breakpoint_list] {
+ if {$bp != $bpnum} {
+ add_breakpoint_frame $bp
+ }
+ }
+}
+
proc asm_win_name {funcname} {
if {$funcname == "*None*"} {return .asm.text}
if [winfo exists $win] {
insert_breakpoint_tag $win [pc_to_line $pclist($cfunc) $pc]
}
+
+# Update the breakpoints window
+
+ add_breakpoint_frame $bpnum
}
#
}
}
}
+
+ delete_breakpoint_frame $bpnum
}
#
proc gdbtk_tcl_busy {} {
if [winfo exists .src] {
- catch {.src.start configure -state disabled}
- catch {.src.stop configure -state normal}
- catch {.src.step configure -state disabled}
- catch {.src.next configure -state disabled}
- catch {.src.continue configure -state disabled}
- catch {.src.finish configure -state disabled}
- catch {.src.up configure -state disabled}
- catch {.src.down configure -state disabled}
- catch {.src.bottom configure -state disabled}
+ .src.start configure -state disabled
+ .src.stop configure -state normal
+ .src.step configure -state disabled
+ .src.next configure -state disabled
+ .src.continue configure -state disabled
+ .src.finish configure -state disabled
+ .src.up configure -state disabled
+ .src.down configure -state disabled
+ .src.bottom configure -state disabled
}
if [winfo exists .asm] {
- catch {.asm.stepi configure -state disabled}
- catch {.asm.nexti configure -state disabled}
- catch {.asm.continue configure -state disabled}
- catch {.asm.finish configure -state disabled}
- catch {.asm.up configure -state disabled}
- catch {.asm.down configure -state disabled}
- catch {.asm.bottom configure -state disabled}
- catch {.asm.close configure -state disabled}
+ .asm.stepi configure -state disabled
+ .asm.nexti configure -state disabled
+ .asm.continue configure -state disabled
+ .asm.finish configure -state disabled
+ .asm.up configure -state disabled
+ .asm.down configure -state disabled
+ .asm.bottom configure -state disabled
}
+ return
}
proc gdbtk_tcl_idle {} {
if [winfo exists .src] {
- catch {.src.start configure -state normal}
- catch {.src.stop configure -state disabled}
- catch {.src.step configure -state normal}
- catch {.src.next configure -state normal}
- catch {.src.continue configure -state normal}
- catch {.src.finish configure -state normal}
- catch {.src.up configure -state normal}
- catch {.src.down configure -state normal}
- catch {.src.bottom configure -state normal}
+ .src.start configure -state normal
+ .src.stop configure -state disabled
+ .src.step configure -state normal
+ .src.next configure -state normal
+ .src.continue configure -state normal
+ .src.finish configure -state normal
+ .src.up configure -state normal
+ .src.down configure -state normal
+ .src.bottom configure -state normal
}
if [winfo exists .asm] {
- catch {.asm.stepi configure -state normal}
- catch {.asm.nexti configure -state normal}
- catch {.asm.continue configure -state normal}
- catch {.asm.finish configure -state normal}
- catch {.asm.up configure -state normal}
- catch {.asm.down configure -state normal}
- catch {.asm.bottom configure -state normal}
- catch {.asm.close configure -state normal}
+ .asm.stepi configure -state normal
+ .asm.nexti configure -state normal
+ .asm.continue configure -state normal
+ .asm.finish configure -state normal
+ .asm.up configure -state normal
+ .asm.down configure -state normal
+ .asm.bottom configure -state normal
}
+ return
}
#
.file_popup add command -label "Edit" -command {exec $editor +$selected_line $selected_file &}
.file_popup add command -label "Set breakpoint" -command {gdb_cmd "break $selected_file:$selected_line"}
+# Use this procedure to get the GDB core to execute the string `cmd'. This is
+# a wrapper around gdb_cmd, which will catch errors, and send output to the
+# command window. It will also cause all of the other windows to be updated.
+
+proc interactive_cmd {cmd} {
+ catch {gdb_cmd "$cmd"} result
+ .cmd.text insert end $result
+ .cmd.text yview -pickplace end
+ update_ptr
+}
+
#
# Bindings:
#
##
# Local procedure:
#
-# create_expr_win - Create expression display window
+# create_expr_window - Create expression display window
#
# Description:
#
}
}
-proc create_expr_win {} {
+proc create_expr_window {} {
if [winfo exists .expr] {raise .expr ; return}
#
proc display_expression {expression} {
- create_expr_win
+ create_expr_window
add_expr $expression
}
# File can't be read. Put error message into .src.nofile window and return.
catch {destroy .src.nofile}
- text .src.nofile -height 25 -width 88 -relief raised \
+ text .src.nofile -height 25 -width 88 -relief sunken \
-borderwidth 2 -yscrollcommand textscrollproc \
-setgrid true -cursor hand2
.src.nofile insert 0.0 $fh
# Actually create and do basic configuration on the text widget.
- text $win -height 25 -width 88 -relief raised -borderwidth 2 \
+ text $win -height 25 -width 88 -relief sunken -borderwidth 2 \
-yscrollcommand textscrollproc -setgrid true -cursor hand2
# Setup all the bindings
bind $win <Enter> {focus %W}
-# bind $win <1> {listing_window_button_1 %W %X %Y %x %y}
bind $win <1> do_nothing
bind $win <B1-Motion> do_nothing
- bind $win n {catch {gdb_cmd next} ; update_ptr}
- bind $win s {catch {gdb_cmd step} ; update_ptr}
- bind $win c {catch {gdb_cmd continue} ; update_ptr}
- bind $win f {catch {gdb_cmd finish} ; update_ptr}
- bind $win u {catch {gdb_cmd up} ; update_ptr}
- bind $win d {catch {gdb_cmd down} ; update_ptr}
+ bind $win <Key-Alt_R> do_nothing
+ bind $win <Key-Alt_L> do_nothing
+ bind $win <Key-Prior> "$win yview {@0,0 - 10 lines}"
+ bind $win <Key-Next> "$win yview {@0,0 + 10 lines}"
+ bind $win <Key-Up> "$win yview {@0,0 - 1 lines}"
+ bind $win <Key-Down> "$win yview {@0,0 + 1 lines}"
+ bind $win <Key-Home> {update_listing [gdb_loc]}
+ bind $win <Key-End> "$win yview -pickplace end"
+
+ bind $win n {interactive_cmd next}
+ bind $win s {interactive_cmd step}
+ bind $win c {interactive_cmd continue}
+ bind $win f {interactive_cmd finish}
+ bind $win u {interactive_cmd up}
+ bind $win d {interactive_cmd down}
$win delete 0.0 end
$win insert 0.0 [read $fh]
$win tag add margin $i.0 $i.8
}
-# $win tag bind margin <1> {listing_window_button_1 %W %X %Y %x %y}
+ $win tag bind margin <1> {listing_window_button_1 %W %X %Y %x %y}
$win tag bind source <1> {
%W mark set anchor "@%x,%y wordstart"
set last [%W index "@%x,%y wordend"]
proc create_asm_win {funcname pc} {
global breakpoint_file
global breakpoint_line
- global current_output_win
global pclist
global disassemble_with_source
# Actually create and do basic configuration on the text widget.
- text $win -height 25 -width 80 -relief raised -borderwidth 2 \
+ text $win -height 25 -width 80 -relief sunken -borderwidth 2 \
-setgrid true -cursor hand2 -yscrollcommand asmscrollproc
# Setup all the bindings
bind $win <Enter> {focus %W}
bind $win <1> {asm_window_button_1 %W %X %Y %x %y}
bind $win <B1-Motion> do_nothing
- bind $win n {catch {gdb_cmd nexti} ; update_ptr}
- bind $win s {catch {gdb_cmd stepi} ; update_ptr}
- bind $win c {catch {gdb_cmd continue} ; update_ptr}
- bind $win f {catch {gdb_cmd finish} ; update_ptr}
- bind $win u {catch {gdb_cmd up} ; update_ptr}
- bind $win d {catch {gdb_cmd down} ; update_ptr}
+
+ bind $win <Key-Alt_R> do_nothing
+ bind $win <Key-Alt_L> do_nothing
+ bind $win <Key-Prior> "$win yview {@0,0 - 10 lines}"
+ bind $win <Key-Next> "$win yview {@0,0 + 10 lines}"
+ bind $win <Key-Up> "$win yview {@0,0 - 1 lines}"
+ bind $win <Key-Down> "$win yview {@0,0 + 1 lines}"
+ bind $win <Key-Home> {update_assembly [gdb_loc]}
+ bind $win <Key-End> "$win yview -pickplace end"
+
+ bind $win n {interactive_cmd nexti}
+ bind $win s {interactive_cmd stepi}
+ bind $win c {interactive_cmd continue}
+ bind $win f {interactive_cmd finish}
+ bind $win u {interactive_cmd up}
+ bind $win d {interactive_cmd down}
# Disassemble the code, and read it into the new text widget
- set temp $current_output_win
- set current_output_win $win
- catch "gdb_disassemble $disassemble_with_source $pc"
- set current_output_win $temp
+ $win insert end [gdb_disassemble $disassemble_with_source $pc]
set numlines [$win index end]
set numlines [lindex [split $numlines .] 0]
frame .asm.row2
button .asm.stepi -width 6 -text Stepi \
- -command {catch {gdb_cmd stepi} ; update_ptr}
+ -command {interactive_cmd stepi}
button .asm.nexti -width 6 -text Nexti \
- -command {catch {gdb_cmd nexti} ; update_ptr}
+ -command {interactive_cmd nexti}
button .asm.continue -width 6 -text Cont \
- -command {catch {gdb_cmd continue} ; update_ptr}
+ -command {interactive_cmd continue}
button .asm.finish -width 6 -text Finish \
- -command {catch {gdb_cmd finish} ; update_ptr}
- button .asm.up -width 6 -text Up -command {catch {gdb_cmd up} ; update_ptr}
+ -command {interactive_cmd finish}
+ button .asm.up -width 6 -text Up -command {interactive_cmd up}
button .asm.down -width 6 -text Down \
- -command {catch {gdb_cmd down} ; update_ptr}
+ -command {interactive_cmd down}
button .asm.bottom -width 6 -text Bottom \
- -command {catch {gdb_cmd {frame 0}} ; update_ptr}
+ -command {interactive_cmd {frame 0}}
pack .asm.stepi .asm.continue .asm.up .asm.bottom -side left -padx 3 -pady 5 -in .asm.row1
pack .asm.nexti .asm.finish .asm.down -side left -padx 3 -pady 5 -in .asm.row2
if [winfo exists .expr] {
update_exprs
}
+ if [winfo exists .autocmd] {
+ update_autocmd
+ }
}
# Make toplevel window disappear
wm minsize .files_window 1 1
# wm overrideredirect .files_window true
listbox .files_window.list -geometry 30x20 -setgrid true \
- -yscrollcommand {.files_window.scroll set} -relief raised \
+ -yscrollcommand {.files_window.scroll set} -relief sunken \
-borderwidth 2
scrollbar .files_window.scroll -orient vertical \
- -command {.files_window.list yview}
+ -command {.files_window.list yview} -relief sunken
button .files_window.close -text Close -command {destroy .files_window}
tk_listboxSingleSelect .files_window.list
-command "destroy ${win}"
${win}.menubar.file.menu add separator
${win}.menubar.file.menu add command -label Quit \
- -command { catch { gdb_cmd quit } }
+ -command {interactive_cmd quit}
menubutton ${win}.menubar.commands -padx 12 -text Commands \
-menu ${win}.menubar.commands.menu -underline 0
menu ${win}.menubar.commands.menu
${win}.menubar.commands.menu add command -label Run \
- -command { catch {gdb_cmd run } ; update_ptr }
+ -command {interactive_cmd run}
${win}.menubar.commands.menu add command -label Step \
- -command { catch { gdb_cmd step } ; update_ptr }
+ -command {interactive_cmd step}
${win}.menubar.commands.menu add command -label Next \
- -command { catch { gdb_cmd next } ; update_ptr }
+ -command {interactive_cmd next}
${win}.menubar.commands.menu add command -label Continue \
- -command { catch { gdb_cmd continue } ; update_ptr }
+ -command {interactive_cmd continue}
${win}.menubar.commands.menu add separator
${win}.menubar.commands.menu add command -label Stepi \
- -command { catch { gdb_cmd stepi } ; update_ptr }
+ -command {interactive_cmd stepi}
${win}.menubar.commands.menu add command -label Nexti \
- -command { catch { gdb_cmd nexti } ; update_ptr }
+ -command {interactive_cmd nexti}
menubutton ${win}.menubar.view -padx 12 -text Options \
-menu ${win}.menubar.view.menu -underline 0
-command create_command_window
${win}.menubar.window.menu add separator
${win}.menubar.window.menu add command -label Source \
- -command {create_source_window ; update_ptr}
+ -command create_source_window
${win}.menubar.window.menu add command -label Assembly \
- -command {create_asm_window ; update_ptr}
+ -command create_asm_window
${win}.menubar.window.menu add separator
${win}.menubar.window.menu add command -label Registers \
- -command {create_registers_window ; update_ptr}
+ -command create_registers_window
${win}.menubar.window.menu add command -label Expressions \
- -command {create_expr_win ; update_ptr}
+ -command create_expr_window
+ ${win}.menubar.window.menu add command -label "Auto Command" \
+ -command create_autocmd_window
+ ${win}.menubar.window.menu add command -label Breakpoints \
+ -command create_breakpoints_window
# ${win}.menubar.window.menu add separator
# ${win}.menubar.window.menu add command -label Files \
pack ${win}.menubar.help -side right
frame ${win}.info
- text ${win}.text -height 25 -width 80 -relief raised -borderwidth 2 \
+ text ${win}.text -height 25 -width 80 -relief sunken -borderwidth 2 \
-setgrid true -cursor hand2 -yscrollcommand "${win}.scroll set"
set ${win}.label $label
- label ${win}.label -textvariable ${win}.label -borderwidth 2 -relief raised
+ label ${win}.label -textvariable ${win}.label -borderwidth 2 -relief sunken
- scrollbar ${win}.scroll -orient vertical -command "${win}.text yview"
+ scrollbar ${win}.scroll -orient vertical -command "${win}.text yview" \
+ -relief sunken
+
+ bind $win <Key-Alt_R> do_nothing
+ bind $win <Key-Alt_L> do_nothing
+ bind $win <Key-Prior> "$win yview {@0,0 - 10 lines}"
+ bind $win <Key-Next> "$win yview {@0,0 + 10 lines}"
+ bind $win <Key-Up> "$win yview {@0,0 - 1 lines}"
+ bind $win <Key-Down> "$win yview {@0,0 + 1 lines}"
+ bind $win <Key-Home> "$win yview -pickplace end"
+ bind $win <Key-End> "$win yview -pickplace end"
pack ${win}.label -side bottom -fill x -in ${win}.info
pack ${win}.scroll -side right -fill y -in ${win}.info
frame .src.row2
button .src.start -width 6 -text Start -command \
- {catch {gdb_cmd {break main}}
- catch {gdb_cmd {enable delete $bpnum}}
- catch {gdb_cmd run}
- update_ptr }
+ {interactive_cmd {break main}
+ interactive_cmd {enable delete $bpnum}
+ interactive_cmd run }
button .src.stop -width 6 -text Stop -fg red -activeforeground red \
-state disabled -command gdb_stop
button .src.step -width 6 -text Step \
- -command {catch {gdb_cmd step} ; update_ptr}
+ -command {interactive_cmd step}
button .src.next -width 6 -text Next \
- -command {catch {gdb_cmd next} ; update_ptr}
+ -command {interactive_cmd next}
button .src.continue -width 6 -text Cont \
- -command {catch {gdb_cmd continue} ; update_ptr}
+ -command {interactive_cmd continue}
button .src.finish -width 6 -text Finish \
- -command {catch {gdb_cmd finish} ; update_ptr}
+ -command {interactive_cmd finish}
button .src.up -width 6 -text Up \
- -command {catch {gdb_cmd up} ; update_ptr}
+ -command {interactive_cmd up}
button .src.down -width 6 -text Down \
- -command {catch {gdb_cmd down} ; update_ptr}
+ -command {interactive_cmd down}
button .src.bottom -width 6 -text Bottom \
- -command {catch {gdb_cmd {frame 0}} ; update_ptr}
+ -command {interactive_cmd {frame 0}}
pack .src.start .src.step .src.continue .src.up .src.bottom \
-side left -padx 3 -pady 5 -in .src.row1
set screen_bot [lindex $args 3]}
}
+proc update_autocmd {} {
+ global .autocmd.label
+ global accumulate_output
+
+ catch {gdb_cmd "${.autocmd.label}"} result
+ if !$accumulate_output { .autocmd.text delete 0.0 end }
+ .autocmd.text insert end $result
+ .autocmd.text yview -pickplace end
+}
+
+proc create_autocmd_window {} {
+ global .autocmd.label
+
+ if [winfo exists .autocmd] {raise .autocmd ; return}
+
+ build_framework .autocmd "Auto Command" ""
+
+# First, delete all the old view menu entries
+
+ .autocmd.menubar.view.menu delete 0 last
+
+# Accumulate output option
+
+ .autocmd.menubar.view.menu add checkbutton \
+ -variable accumulate_output \
+ -label "Accumulate output" -onvalue 1 -offvalue 0
+
+# Now, create entry widget with label
+
+ frame .autocmd.entryframe
+
+ entry .autocmd.entry -borderwidth 2 -relief sunken
+ bind .autocmd <Enter> {focus .autocmd.entry}
+ bind .autocmd.entry <Key-Return> {set .autocmd.label [.autocmd.entry get]
+ .autocmd.entry delete 0 end }
+
+ label .autocmd.entrylab -text "Command: "
+
+ pack .autocmd.entrylab -in .autocmd.entryframe -side left
+ pack .autocmd.entry -in .autocmd.entryframe -side left -fill x -expand yes
+
+ pack .autocmd.entryframe -side bottom -fill x -before .autocmd.info
+}
+
+# Return the longest common prefix in SLIST. Can be empty string.
+
+proc find_lcp slist {
+# Handle trivial cases where list is empty or length 1
+ if {[llength $slist] <= 1} {return [lindex $slist 0]}
+
+ set prefix [lindex $slist 0]
+ set prefixlast [expr [string length $prefix] - 1]
+
+ foreach str [lrange $slist 1 end] {
+ set test_str [string range $str 0 $prefixlast]
+ while {[string compare $test_str $prefix] != 0} {
+ decr prefixlast
+ set prefix [string range $prefix 0 $prefixlast]
+ set test_str [string range $str 0 $prefixlast]
+ }
+ if {$prefixlast < 0} break
+ }
+ return $prefix
+}
+
+# Look through COMPLETIONS to generate the suffix needed to do command
+# completion on CMD.
+
+proc find_completion {cmd completions} {
+# Get longest common prefix
+ set lcp [find_lcp $completions]
+ set cmd_len [string length $cmd]
+# Return suffix beyond end of cmd
+ return [string range $lcp $cmd_len end]
+}
+
proc create_command_window {} {
global command_line
+ global saw_tab
+ set saw_tab 0
if [winfo exists .cmd] {raise .cmd ; return}
build_framework .cmd Command "* Command Buffer *"
bind .cmd.text <Enter> {focus %W}
bind .cmd.text <Delete> {delete_char %W}
bind .cmd.text <BackSpace> {delete_char %W}
+ bind .cmd.text <Control-c> gdb_stop
bind .cmd.text <Control-u> {delete_line %W}
bind .cmd.text <Any-Key> {
global command_line
+ global saw_tab
+ set saw_tab 0
%W insert end %A
%W yview -pickplace end
append command_line %A
}
bind .cmd.text <Key-Return> {
global command_line
+ global saw_tab
+ set saw_tab 0
%W insert end \n
- %W yview -pickplace end
- catch "gdb_cmd [list $command_line]"
+ interactive_cmd $command_line
+
+# %W yview -pickplace end
+# catch "gdb_cmd [list $command_line]" result
+# %W insert end $result
set command_line {}
- update_ptr
+# update_ptr
%W insert end "(gdb) "
%W yview -pickplace end
}
%W yview -pickplace end
append command_line [selection get]
}
+ bind .cmd.text <Key-Tab> {
+ global command_line
+ global saw_tab
+ global choices
+
+ set choices [gdb_cmd "complete $command_line"]
+ set choices [string trimright $choices \n]
+ set choices [split $choices \n]
+
+# Just do completion if this is the first tab
+ if !$saw_tab {
+ set saw_tab 1
+ set completion [find_completion $command_line $choices]
+ append command_line $completion
+# Here is where the completion is actually done. If there is one match,
+# complete the command and print a space. If two or more matches, complete the
+# command and beep. If no match, just beep.
+ switch -exact [llength $choices] {
+ 0 {}
+ 1 {%W insert end "$completion "
+ append command_line " "
+ return }
+ default {%W insert end "$completion"}
+ }
+ puts -nonewline stdout \007
+ flush stdout
+ %W yview -pickplace end
+ } else {
+# User hit another consecutive tab. List the choices. Note that at this
+# point, choices may contain commands with spaces. We have to lop off
+# everything before (and including) the last space so that the completion
+# list only shows the possibilities for the last token.
+
+ set choices [lsort $choices]
+ if [regexp ".* " $command_line prefix] {
+ regsub -all $prefix $choices {} choices
+ }
+ %W insert end "\n[join $choices { }]\n(gdb) $command_line"
+ %W yview -pickplace end
+ }
+ }
proc delete_char {win} {
global command_line
# Create a copyright window
+update
toplevel .c
wm geometry .c +300+300
wm overrideredirect .c true
-text .t
-set temp $current_output_win
-set current_output_win .t
-gdb_cmd "show version"
-set current_output_win $temp
-
-message .c.m -text [.t get 0.0 end] -aspect 500 -relief raised
-destroy .t
+message .c.m -text [gdb_cmd "show version"] -aspect 500 -relief raised
pack .c.m
bind .c.m <Leave> {destroy .c}
+update
if [file exists ~/.gdbtkinit] {
source ~/.gdbtkinit
}
-
-update
projects / deliverable / binutils-gdb.git / blobdiff