1977c1977,1992
<     }
---
>     } elseif {[llength [info commands ::console]] == 0} {
> 	     ::tkchat::ConsoleInit
> 		  $m entryconfigure "Console" -state normal
> 		  console eval {
> 	    bind .console <Map> {
> 		consoleinterp eval {
> 		    set ::tkchat::_console 1
> 		}
> 	    }
> 	    bind .console <Unmap> {
> 		consoleinterp eval {
> 		    set ::tkchat::_console 0
> 		}
> 	    }
> 	}
> 	 }
6741a6757,6943
> 
> proc ::tkchat::ConsoleInit {} {
>     #####
> 	 #
> 	 # "console for Unix"
> 	 # http://wiki.tcl.tk/786
> 	 #
> 	 # Tcl code harvested on:   2 Mai 2006, 20:16 GMT
> 	 #
> 	 #       Provides a console window.
> 	 #
> 	 # Last modified on: $Date: 2002/06/21 02:26:00 $
> 	 # Last modified by: $Author: jcw $
> 	 #
> 	 # modified to fit into TkChat by Torsten Reincke
> 	 #
> 	 # This file is evaluated to provide a console window interface to the
> 	 # root Tcl interpreter of an OOMMF application.  It calls on a script
> 	 # included with the Tk script library to do most of the work, making use
> 	 # of Tk interface details which are only semi-public.  For this reason,
> 	 # there is some risk that future versions of Tk will no longer support
> 	 # this script.  That is why this script has been isolated in a file of
> 	 # its own.
> 
> 	 set _ [file join $::tk_library console.tcl]
> 	 if {![file readable $_]} {
>    	  return -code error "File not readable: $_"
> 	 }
> 
> 	 ########################################################################
> 	 # Provide the support which the Tk library script console.tcl assumes
> 	 ########################################################################
> 	 # 1. Create an interpreter for the console window widget and load Tk
> 	 set consoleInterp [interp create]
> 	 $consoleInterp eval [list set ::tk_library $::tk_library]
> 	 $consoleInterp alias exit exit
> 	 load "" Tk $consoleInterp
> 
> 	 # 2. A command 'console' in the application interpreter
> 	 proc ::console {sub {optarg {}}} [subst -nocommands {
>    	  switch -exact -- \$sub {
>       	  title {
>          		$consoleInterp eval wm title . [list \$optarg]
>       	  }
>       	  hide {
>          		$consoleInterp eval wm withdraw .
>       	  }
>       	  show {
>          		$consoleInterp eval wm deiconify .
>       	  }
>       	  eval {
>          		$consoleInterp eval \$optarg
>       	  }
>       	  default {
>          		error "bad option \\\"\$sub\\\": should be hide, show, or title"
>       	  }
>    	 }
> 	 }]
> 
> 	 # 3. Alias a command 'consoleinterp' in the console window interpreter
> 	 #       to cause evaluation of the command 'consoleinterp' in the
> 	 #       application interpreter.
> 	 proc ::consoleinterp {sub cmd} {
>    	 switch -exact -- $sub {
>       	  eval {
>          		uplevel #0 $cmd
>       	  }
>       	  record {
>          		history add $cmd
>          		catch {uplevel #0 $cmd} retval
>          		return $retval
>       	  }
>       	  default {
>          		error "bad option \"$sub\": should be eval or record"
>       	  }
>    	 }
> 	 }
> 	 $consoleInterp alias consoleinterp consoleinterp
> 
> 	 # 4. Bind the <Destroy> event of the application interpreter's main
> 	 #    window to kill the console (via tkConsoleExit)
> 	 bind . <Destroy> [list +if {[string match . %W]} [list catch \
>       	  [list $consoleInterp eval tkConsoleExit]]]
> 
> 	 # 5. Redefine the Tcl command 'puts' in the application interpreter
> 	 #    so that messages to stdout and stderr appear in the console.
> 	 rename ::puts ::tcl_puts
> 	 proc ::puts {args} [subst -nocommands {
>    	 switch -exact -- [llength \$args] {
>       	  1 {
>          		if {[string match -nonewline \$args]} {
>                	 if {[catch {uplevel 1 [linsert \$args 0 tcl_puts]} msg]} {
>                   	  regsub -all tcl_puts \$msg puts msg
>                   	  return -code error \$msg
>                	 }
>          		} else {
>                	 $consoleInterp eval [list tkConsoleOutput stdout \
>                      		"[lindex \$args 0]\n"]
>          		}
>       	  }
>       	  2 {
>          		if {[string match -nonewline [lindex \$args 0]]} {
>                	 $consoleInterp eval [list tkConsoleOutput stdout \
>                      		[lindex \$args 1]]
>          		} elseif {[string match stdout [lindex \$args 0]]} {
>                	 $consoleInterp eval [list tkConsoleOutput stdout \
>                      		"[lindex \$args 1]\n"]
>          		} elseif {[string match stderr [lindex \$args 0]]} {
>                	 $consoleInterp eval [list tkConsoleOutput stderr \
>                      		"[lindex \$args 1]\n"]
>          		} else {
>                	 if {[catch {uplevel 1 [linsert \$args 0 tcl_puts]} msg]} {
>                   	  regsub -all tcl_puts \$msg puts msg
>                   	  return -code error \$msg
>                	 }
>          		}
>       	  }
>       	  3 {
>          		if {![string match -nonewline [lindex \$args 0]]} {
>                	 if {[catch {uplevel 1 [linsert \$args 0 tcl_puts]} msg]} {
>                   	  regsub -all tcl_puts \$msg puts msg
>                   	  return -code error \$msg
>                	 }
>          		} elseif {[string match stdout [lindex \$args 1]]} {
>                	 $consoleInterp eval [list tkConsoleOutput stdout \
>                      		[lindex \$args 2]]
>          		} elseif {[string match stderr [lindex \$args 1]]} {
>                	 $consoleInterp eval [list tkConsoleOutput stderr \
>                      		[lindex \$args 2]]
>          		} else {
>                	 if {[catch {uplevel 1 [linsert \$args 0 tcl_puts]} msg]} {
>                   	  regsub -all tcl_puts \$msg puts msg
>                   	  return -code error \$msg
>                	 }
>          		}
>       	  }
>       	  default {
>          		if {[catch {uplevel 1 [linsert \$args 0 tcl_puts]} msg]} {
>                	 regsub -all tcl_puts \$msg puts msg
>                	 return -code error \$msg
>          		}
>       	  }
>    	 }
> 	 }]
> 	 $consoleInterp alias puts puts
> 
> 	 # 6. No matter what Tk_Main says, insist that this is an interactive  shell
> 	 set ::tcl_interactive 1
> 
> 	 ########################################################################
> 	 # Evaluate the Tk library script console.tcl in the console interpreter
> 	 ########################################################################
> 	 $consoleInterp eval source [list [file join $::tk_library console.tcl]]
> 	 $consoleInterp eval {
>    	 if {![llength [info commands ::tkConsoleExit]]} {
>       	  tk::unsupported::ExposePrivateCommand tkConsoleExit
>    	 }
> 	 }
> 	 $consoleInterp eval {
>    	 if {![llength [info commands ::tkConsoleOutput]]} {
>       	  tk::unsupported::ExposePrivateCommand tkConsoleOutput
>    	 }
> 	 }
> 	 if {[string match 8.3.4 $::tk_patchLevel]} {
>    	 # Workaround bug in first draft of the tkcon enhancments
>    	 $consoleInterp eval {
>       	  bind Console <Control-Key-v> {}
>    	 }
> 	 }
> 	 # Restore normal [puts] if console widget goes away...
> 	 proc ::Oc_RestorePuts {slave} {
>    	  rename ::puts {}
>    	  rename ::tcl_puts ::puts
>    	  interp delete $slave
> 	 }
> 	 $consoleInterp alias Oc_RestorePuts Oc_RestorePuts $consoleInterp
> 	 $consoleInterp eval {
>    	  bind Console <Destroy> +Oc_RestorePuts
> 	 }
> 
> 	 unset consoleInterp
> 	 ::console title "[wm title .] Console"
> 	 ::console hide
> }
> 
> 
> 
