diff options
author | Martin Hunt <hunt@redhat.com> | 2002-12-18 19:35:55 +0000 |
---|---|---|
committer | Martin Hunt <hunt@redhat.com> | 2002-12-18 19:35:55 +0000 |
commit | 6667f2950d213490dce73f5e6bd8387e5b57a38d (patch) | |
tree | 9604aa81daec473e1bfd1333457eed58f1be9f3f | |
parent | 7493ad00587850ff5a42579fd6e3721418f42072 (diff) | |
download | gdb-6667f2950d213490dce73f5e6bd8387e5b57a38d.tar.gz |
2002-12-17 Martin M. Hunt <hunt@redhat.com>
* library/interface.tcl (gdbtk_tcl_fputs_target_err):
New function.
(gdbtk_tcl_fputs_target): Open console window if it is
not already open.
(gdbtk_gets): New function.
Opens a console window if necessary and calls Console::gets.
* library/console.ith (gets): Declare method.
(_input_mode): New private variable.
(_input_result): Ditto.
(_input_error): Ditto.
(_cancel): New private method
(invoke): Add arg.
* library/console.itb (_setprompt): Allow setting prompt
to nothing. Delete to beginning of line before writing prompt.
(gets): New public method to prompt user for input.
(_cancel): New private method to handle ^C when inputting data.
(invoke): Check for ^d when in input mode.
-rw-r--r-- | gdb/gdbtk/ChangeLog | 22 | ||||
-rw-r--r-- | gdb/gdbtk/library/console.itb | 58 | ||||
-rw-r--r-- | gdb/gdbtk/library/console.ith | 7 | ||||
-rw-r--r-- | gdb/gdbtk/library/interface.tcl | 29 |
4 files changed, 105 insertions, 11 deletions
diff --git a/gdb/gdbtk/ChangeLog b/gdb/gdbtk/ChangeLog index 9bcbebbc0b6..bb0bbc869a8 100644 --- a/gdb/gdbtk/ChangeLog +++ b/gdb/gdbtk/ChangeLog @@ -1,5 +1,27 @@ 2002-12-17 Martin M. Hunt <hunt@redhat.com> + * library/interface.tcl (gdbtk_tcl_fputs_target_err): + New function. + (gdbtk_tcl_fputs_target): Open console window if it is + not already open. + (gdbtk_gets): New function. + Opens a console window if necessary and calls Console::gets. + + * library/console.ith (gets): Declare method. + (_input_mode): New private variable. + (_input_result): Ditto. + (_input_error): Ditto. + (_cancel): New private method + (invoke): Add arg. + + * library/console.itb (_setprompt): Allow setting prompt + to nothing. Delete to beginning of line before writing prompt. + (gets): New public method to prompt user for input. + (_cancel): New private method to handle ^C when inputting data. + (invoke): Check for ^d when in input mode. + +2002-12-17 Martin M. Hunt <hunt@redhat.com> + * library/regwin.itb (_load_prefs): Get list of registers from the group name. (_build_win): Remove old menu system. Replace with an optionmenu diff --git a/gdb/gdbtk/library/console.itb b/gdb/gdbtk/library/console.itb index c31c7004011..3a51a3fc572 100644 --- a/gdb/gdbtk/library/console.itb +++ b/gdb/gdbtk/library/console.itb @@ -369,15 +369,14 @@ itcl::body Console::_first {} { # METHOD: _setprompt - put a prompt at the beginning of a line # ------------------------------------------------------------------ itcl::body Console::_setprompt {{prompt {}}} { - if {$_invoking} { - set prompt "" - } elseif {"$prompt" != ""} { - # nothing - } else { + if {$prompt == ""} { #set prompt [pref get gdb/console/prompt] set prompt [gdb_prompt] + } elseif {$prompt == "none"} { + set prompt "" } - + + $_twin delete {insert linestart} {insert lineend} $_twin insert {insert linestart} $prompt prompt_tag $_twin mark set cmdmark "insert -1 char" $_twin see insert @@ -390,6 +389,44 @@ itcl::body Console::_setprompt {{prompt {}}} { } #------------------------------------------------------------------- +# METHOD: gets - get a line of input from the console +# ------------------------------------------------------------------ +itcl::body Console::gets {} { + set _input_mode 1 +# _setprompt "(input) " + _setprompt none + $_twin delete insert end + $_twin mark set cmdmark {insert -1 char} + + bind_plain_key $_twin Control-d "$this invoke 1; break" + bind_plain_key $_twin Control-c "[code $this _cancel]; break" + + vwait [scope _input_result] + set _input_mode 0 + bind_plain_key $_twin Control-c "event generate $_twin <<Copy>>" + activate + if {$_input_error} { + set _input_error 0 + return -code error "" + } + return $_input_result +} + +#------------------------------------------------------------------- +# METHOD: cancel - cancel input when ^C is hit +# ------------------------------------------------------------------ +itcl::body Console::_cancel {} { + if {$_input_mode} { + set _needNL 1 + $_twin mark set insert {insert lineend} + $_twin insert {insert lineend} "^C\n" + incr _invoking + set _input_error 1 + set _input_result "" + } +} + +#------------------------------------------------------------------- # METHOD: activate - run this after a command is run # ------------------------------------------------------------------ itcl::body Console::activate {{prompt {}}} { @@ -402,7 +439,7 @@ itcl::body Console::activate {{prompt {}}} { #------------------------------------------------------------------- # METHOD: invoke - invoke a command # ------------------------------------------------------------------ -itcl::body Console::invoke {} { +itcl::body Console::invoke {{controld 0}} { global gdbtk_state set text [$_twin get {cmdmark + 1 char} end ] @@ -433,6 +470,13 @@ itcl::body Console::invoke {} { } } + if {$_input_mode} { + if {!$controld} {append text \n} + set _input_result $text + set _needNL 1 + return + } + # Only push new nonempty history items. if {$text != "" && [lindex $_history 0] != $text} { lvarpush _history $text diff --git a/gdb/gdbtk/library/console.ith b/gdb/gdbtk/library/console.ith index 8bfd2ce367b..a574f068703 100644 --- a/gdb/gdbtk/library/console.ith +++ b/gdb/gdbtk/library/console.ith @@ -27,10 +27,11 @@ itcl::class Console { method constructor {args} method destructor {} method insert {line {tag ""}} - method invoke {} + method invoke {{controld 0}} method _insertion {args} method activate {{prompt {}}} method test {args} + method gets {} # # GDB Events @@ -50,8 +51,12 @@ itcl::class Console { variable _running 0 variable _saw_tab 0 variable _pendingHistElement -1 + variable _input_mode 0 + variable _input_result "" + variable _input_error 0 method _build_win {} + method _cancel {} method _complete {} method _delete {{left 0}} method _find_completion {cmd completions} diff --git a/gdb/gdbtk/library/interface.tcl b/gdb/gdbtk/library/interface.tcl index bddc3e76070..4c810a9aca1 100644 --- a/gdb/gdbtk/library/interface.tcl +++ b/gdb/gdbtk/library/interface.tcl @@ -454,10 +454,22 @@ proc gdbtk_tcl_fputs_log {message} { # PROC: gdbtk_tcl_fputs_target - write target output # ------------------------------------------------------------------ proc gdbtk_tcl_fputs_target {message} { - if {$::gdbtk_state(console) != ""} { - $::gdbtk_state(console) insert $message target_tag - update + if {$::gdbtk_state(console) == ""} { + ManagedWin::open Console -force } + $::gdbtk_state(console) insert $message target_tag + update +} + + +# ------------------------------------------------------------------ +# PROC: gdbtk_tcl_fputs_target_err - write target error output +# ------------------------------------------------------------------ +proc gdbtk_tcl_fputs_target_err {message} { + if {$::gdbtk_state(console) == ""} { + ManagedWin::open Console -force + } + $::gdbtk_state(console) insert $message err_tag } # ------------------------------------------------------------------ @@ -1790,3 +1802,14 @@ proc gdbtk_tcl_architecture_changed {} { GDBEventHandler::dispatch $e delete object $e } + +proc gdbtk_console_read {} { + if {$::gdbtk_state(console) == ""} { + ManagedWin::open Console -force + } else { + raise [namespace tail $::gdbtk_state(console)] + } + set result [$::gdbtk_state(console) gets] + debug "result=$result" + return $result +} |