* gdbtk.tcl (gdb_prompt): Set this early on.
(create_command_window): Use gdb_prompt rather than "(gdb) ". (gdbtk_tcl_preloop): Proc executed just prior to Tk main loop. (tclsh): If an evaluation window already exists, just bring it to the front instead of trying to create another. * gdbtk.c (tk_command_loop): New function. (gdbtk_init): Call tk_command_loop rather than Tk_MainLoop.
This commit is contained in:
parent
954a4a2ab1
commit
5bac2b50e2
@ -1,4 +1,14 @@
|
|||||||
start-sanitize-gdbtk
|
start-sanitize-gdbtk
|
||||||
|
Thu May 16 19:20:29 1996 Fred Fish <fnf@fishfood.ninemoons.com>
|
||||||
|
|
||||||
|
* gdbtk.tcl (gdb_prompt): Set this early on.
|
||||||
|
(create_command_window): Use gdb_prompt rather than "(gdb) ".
|
||||||
|
(gdbtk_tcl_preloop): Proc executed just prior to Tk main loop.
|
||||||
|
(tclsh): If an evaluation window already exists, just bring it
|
||||||
|
to the front instead of trying to create another.
|
||||||
|
* gdbtk.c (tk_command_loop): New function.
|
||||||
|
(gdbtk_init): Call tk_command_loop rather than Tk_MainLoop.
|
||||||
|
|
||||||
Thu May 16 16:16:35 1996 Fred Fish <fnf@cygnus.com>
|
Thu May 16 16:16:35 1996 Fred Fish <fnf@cygnus.com>
|
||||||
|
|
||||||
* gdbtk.tcl (evaluate_tcl_command, tclsh): New functions that
|
* gdbtk.tcl (evaluate_tcl_command, tclsh): New functions that
|
||||||
|
12
gdb/gdbtk.c
12
gdb/gdbtk.c
@ -1111,6 +1111,16 @@ gdbtk_call_command (cmdblk, arg, from_tty)
|
|||||||
(*cmdblk->function.cfunc)(arg, from_tty);
|
(*cmdblk->function.cfunc)(arg, from_tty);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* This function is called instead of gdb's internal command loop. This is the
|
||||||
|
last chance to do anything before entering the main Tk event loop. */
|
||||||
|
|
||||||
|
static void
|
||||||
|
tk_command_loop ()
|
||||||
|
{
|
||||||
|
Tcl_Eval (interp, "gdbtk_tcl_preloop");
|
||||||
|
Tk_MainLoop ();
|
||||||
|
}
|
||||||
|
|
||||||
static void
|
static void
|
||||||
gdbtk_init ()
|
gdbtk_init ()
|
||||||
{
|
{
|
||||||
@ -1160,7 +1170,7 @@ gdbtk_init ()
|
|||||||
Tcl_CreateCommand (interp, "gdb_get_breakpoint_info", call_wrapper,
|
Tcl_CreateCommand (interp, "gdb_get_breakpoint_info", call_wrapper,
|
||||||
gdb_get_breakpoint_info, NULL);
|
gdb_get_breakpoint_info, NULL);
|
||||||
|
|
||||||
command_loop_hook = Tk_MainLoop;
|
command_loop_hook = tk_command_loop;
|
||||||
print_frame_info_listing_hook = null_routine;
|
print_frame_info_listing_hook = null_routine;
|
||||||
query_hook = gdbtk_query;
|
query_hook = gdbtk_query;
|
||||||
flush_hook = gdbtk_flush;
|
flush_hook = gdbtk_flush;
|
||||||
|
@ -28,6 +28,7 @@ set line_numbers 1
|
|||||||
set breakpoint_file(-1) {[garbage]}
|
set breakpoint_file(-1) {[garbage]}
|
||||||
set disassemble_with_source nosource
|
set disassemble_with_source nosource
|
||||||
set expr_update_list(0) 0
|
set expr_update_list(0) 0
|
||||||
|
set gdb_prompt "(gdb) "
|
||||||
|
|
||||||
set debug_interface 0
|
set debug_interface 0
|
||||||
|
|
||||||
@ -2291,6 +2292,7 @@ proc find_completion {cmd completions} {
|
|||||||
proc create_command_window {} {
|
proc create_command_window {} {
|
||||||
global command_line
|
global command_line
|
||||||
global saw_tab
|
global saw_tab
|
||||||
|
global gdb_prompt
|
||||||
|
|
||||||
set saw_tab 0
|
set saw_tab 0
|
||||||
if {[winfo exists .cmd]} {raise .cmd ; return}
|
if {[winfo exists .cmd]} {raise .cmd ; return}
|
||||||
@ -2340,7 +2342,7 @@ proc create_command_window {} {
|
|||||||
# %W insert end $result
|
# %W insert end $result
|
||||||
set command_line {}
|
set command_line {}
|
||||||
# update_ptr
|
# update_ptr
|
||||||
%W insert end "(gdb) "
|
%W insert end "$gdb_prompt"
|
||||||
%W see end
|
%W see end
|
||||||
break
|
break
|
||||||
}
|
}
|
||||||
@ -2391,7 +2393,7 @@ proc create_command_window {} {
|
|||||||
if {[regexp ".* " $command_line prefix]} {
|
if {[regexp ".* " $command_line prefix]} {
|
||||||
regsub -all $prefix $choices {} choices
|
regsub -all $prefix $choices {} choices
|
||||||
}
|
}
|
||||||
%W insert end "\n[join $choices { }]\n(gdb) $command_line"
|
%W insert end "\n[join $choices { }]\n$gdb_prompt$command_line"
|
||||||
%W see end
|
%W see end
|
||||||
}
|
}
|
||||||
break
|
break
|
||||||
@ -3128,6 +3130,9 @@ proc evaluate_tcl_command { twidget } {
|
|||||||
proc tclsh {} {
|
proc tclsh {} {
|
||||||
global tcl_prompt
|
global tcl_prompt
|
||||||
|
|
||||||
|
# If another evaluation window already exists, just bring it to the front.
|
||||||
|
if {[winfo exists .eval]} {raise .eval ; return}
|
||||||
|
|
||||||
# Create top level frame with scrollbar and text widget.
|
# Create top level frame with scrollbar and text widget.
|
||||||
toplevel .eval
|
toplevel .eval
|
||||||
wm title .eval "Tcl Evaluation"
|
wm title .eval "Tcl Evaluation"
|
||||||
@ -3156,6 +3161,14 @@ proc tclsh {} {
|
|||||||
bindtags .eval.text {.eval.text Text all}
|
bindtags .eval.text {.eval.text Text all}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
# This proc is executed just prior to falling into the Tk main event loop.
|
||||||
|
proc gdbtk_tcl_preloop {} {
|
||||||
|
global gdb_prompt
|
||||||
|
.cmd.text insert end "$gdb_prompt"
|
||||||
|
.cmd.text see end
|
||||||
|
update
|
||||||
|
}
|
||||||
|
|
||||||
# FIXME need to handle mono here. In Tk4 that is more complicated.
|
# FIXME need to handle mono here. In Tk4 that is more complicated.
|
||||||
set highlight "-background red2 -borderwidth 2 -relief sunken"
|
set highlight "-background red2 -borderwidth 2 -relief sunken"
|
||||||
|
|
||||||
|
Loading…
x
Reference in New Issue
Block a user