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.

diff --git a/gdb/gdbtk/ChangeLog b/gdb/gdbtk/ChangeLog
index 9bcbebb..bb0bbc8 100644 (file)
--- 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 c31c700..3a51a3f 100644 (file)
--- 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 8bfd2ce..a574f06 100644 (file)
--- 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 bddc3e7..4c810a9 100644 (file)
--- 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
+}