# console.tcl --

#

# This code constructs the console window for an application.  It

# can be used by non-unix systems that do not have built-in support

# for shells.

#

# RCS: @(#) $Id: console.tcl,v 1.22.2.4 2005/11/30 01:22:55 hobbs Exp $

#

# Copyright (c) 1995-1997 Sun Microsystems, Inc.

# Copyright (c) 1998-2000 Ajuba Solutions.

#

# See the file "license.terms" for information on usage and redistribution

# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#

# TODO: history - remember partially written command

namespace eval ::tk::console {

    variable blinkTime   500 ; # msecs to blink braced range for

    variable blinkRange  1   ; # enable blinking of the entire braced range

    variable magicKeys   1   ; # enable brace matching and proc/var recognition

    variable maxLines    600 ; # maximum # of lines buffered in console

    variable showMatches 1   ; # show multiple expand matches

    variable inPlugin [info exists embed_args]

    variable defaultPrompt  ; # default prompt if tcl_prompt1 isn't used

    if {$inPlugin} {

	set defaultPrompt {subst {[history nextid] % }}

    } else {

	set defaultPrompt {subst {([file tail [pwd]]) [history nextid] % }}

    }

}

# simple compat function for tkcon code added for this console

interp alias {} EvalAttached {} consoleinterp eval

# ::tk::ConsoleInit --

# This procedure constructs and configures the console windows.

#

# Arguments:

# 	None.

proc ::tk::ConsoleInit {} {

    global tcl_platform

    if {![consoleinterp eval {set tcl_interactive}]} {

	wm withdraw .

    }

    if {[string equal $tcl_platform(platform) "macintosh"]

	    || [string equal [tk windowingsystem] "aqua"]} {

	set mod "Cmd"

    } else {

	set mod "Ctrl"

    }

    if {[catch {menu .menubar} err]} { bgerror "INIT: $err" }

    .menubar add cascade -label File -menu .menubar.file -underline 0

    .menubar add cascade -label Edit -menu .menubar.edit -underline 0

    menu .menubar.file -tearoff 0

    .menubar.file add command -label [mc "Source..."] \

	    -underline 0 -command tk::ConsoleSource

    .menubar.file add command -label [mc "Hide Console"] \

	    -underline 0 -command {wm withdraw .}

    .menubar.file add command -label [mc "Clear Console"] \

	    -underline 0 -command {.console delete 1.0 "promptEnd linestart"}

   if {[string equal $tcl_platform(platform) "macintosh"]

	   || [string equal [tk windowingsystem] "aqua"]} {

	.menubar.file add command -label [mc "Quit"] \

		-command exit -accel Cmd-Q

    } else {

	.menubar.file add command -label [mc "Exit"] \

		-underline 1 -command exit

    }

    menu .menubar.edit -tearoff 0

    .menubar.edit add command -label [mc "Cut"] -underline 2 \

	    -command { event generate .console <<Cut>> } -accel "$mod+X"

    .menubar.edit add command -label [mc "Copy"] -underline 0 \

	    -command { event generate .console <<Copy>> } -accel "$mod+C"

    .menubar.edit add command -label [mc "Paste"] -underline 1 \

	    -command { event generate .console <<Paste>> } -accel "$mod+V"

    if {[string compare $tcl_platform(platform) "windows"]} {

	.menubar.edit add command -label [mc "Clear"] -underline 2 \

		-command { event generate .console <<Clear>> }

    } else {

	.menubar.edit add command -label [mc "Delete"] -underline 0 \

		-command { event generate .console <<Clear>> } -accel "Del"

	.menubar add cascade -label Help -menu .menubar.help -underline 0

	menu .menubar.help -tearoff 0

	.menubar.help add command -label [mc "About..."] \

		-underline 0 -command tk::ConsoleAbout

    }

    . configure -menu .menubar

    set con [text .console  -yscrollcommand [list .sb set] -setgrid true]

    scrollbar .sb -command [list $con yview]

    pack .sb -side right -fill both

    pack $con -fill both -expand 1 -side left

    switch -exact $tcl_platform(platform) {

	"macintosh" {

	    $con configure -font {Monaco 9 normal} -highlightthickness 0

	}

	"windows" {

	    $con configure -font systemfixed

	}

	"unix" {

	    if {[string equal [tk windowingsystem] "aqua"]} {

		$con configure -font {Monaco 9 normal} -highlightthickness 0

	    }

	}

    }

    ConsoleBind $con

    $con tag configure stderr	-foreground red

    $con tag configure stdin	-foreground blue

    $con tag configure prompt	-foreground \#8F4433

    $con tag configure proc	-foreground \#008800

    $con tag configure var	-background \#FFC0D0

    $con tag raise sel

    $con tag configure blink	-background \#FFFF00

    $con tag configure find	-background \#FFFF00

    focus $con

    wm protocol . WM_DELETE_WINDOW { wm withdraw . }

    wm title . [mc "Console"]

    flush stdout

    $con mark set output [$con index "end - 1 char"]

    tk::TextSetCursor $con end

    $con mark set promptEnd insert

    $con mark gravity promptEnd left

    # A variant of ConsolePrompt to avoid a 'puts' call

    set w $con

    set temp [$w index "end - 1 char"]

    $w mark set output end

    if {![consoleinterp eval "info exists tcl_prompt1"]} {

	set string [EvalAttached $::tk::console::defaultPrompt]

	$w insert output $string stdout

    }

    $w mark set output $temp

    ::tk::TextSetCursor $w end

    $w mark set promptEnd insert

    $w mark gravity promptEnd left

    if {$tcl_platform(platform) eq "windows"} {

	# Subtle work-around to erase the '% ' that tclMain.c prints out

	after idle [subst -nocommand {

	    if {[$con get 1.0 output] eq "% "} { $con delete 1.0 output }

	}]

    }

}

# ::tk::ConsoleSource --

#

# Prompts the user for a file to source in the main interpreter.

#

# Arguments:

# None.

proc ::tk::ConsoleSource {} {

    set filename [tk_getOpenFile -defaultextension .tcl -parent . \

	    -title [mc "Select a file to source"] \

	    -filetypes [list \

	    [list [mc "Tcl Scripts"] .tcl] \

	    [list [mc "All Files"] *]]]

    if {[string compare $filename ""]} {

    	set cmd [list source $filename]

	if {[catch {consoleinterp eval $cmd} result]} {

	    ConsoleOutput stderr "$result\n"

	}

    }

}

# ::tk::ConsoleInvoke --

# Processes the command line input.  If the command is complete it

# is evaled in the main interpreter.  Otherwise, the continuation

# prompt is added and more input may be added.

#

# Arguments:

# None.

proc ::tk::ConsoleInvoke {args} {

    set ranges [.console tag ranges input]

    set cmd ""

    if {[llength $ranges]} {

	set pos 0

	while {[string compare [lindex $ranges $pos] ""]} {

	    set start [lindex $ranges $pos]

	    set end [lindex $ranges [incr pos]]

	    append cmd [.console get $start $end]

	    incr pos

	}

    }

    if {[string equal $cmd ""]} {

	ConsolePrompt

    } elseif {[info complete $cmd]} {

	.console mark set output end

	.console tag delete input

	set result [consoleinterp record $cmd]

	if {[string compare $result ""]} {

	    puts $result

	}

	ConsoleHistory reset

	ConsolePrompt

    } else {

	ConsolePrompt partial

    }

    .console yview -pickplace insert

}

# ::tk::ConsoleHistory --

# This procedure implements command line history for the

# console.  In general is evals the history command in the

# main interpreter to obtain the history.  The variable

# ::tk::HistNum is used to store the current location in the history.

#

# Arguments:

# cmd -	Which action to take: prev, next, reset.

set ::tk::HistNum 1

proc ::tk::ConsoleHistory {cmd} {

    variable HistNum

    switch $cmd {

    	prev {

	    incr HistNum -1

	    if {$HistNum == 0} {

		set cmd {history event [expr {[history nextid] -1}]}

	    } else {

		set cmd "history event $HistNum"

	    }

    	    if {[catch {consoleinterp eval $cmd} cmd]} {

    	    	incr HistNum

    	    	return

    	    }

	    .console delete promptEnd end

    	    .console insert promptEnd $cmd {input stdin}

    	}

    	next {

	    incr HistNum

	    if {$HistNum == 0} {

		set cmd {history event [expr {[history nextid] -1}]}

	    } elseif {$HistNum > 0} {

		set cmd ""

		set HistNum 1

	    } else {

		set cmd "history event $HistNum"

	    }

	    if {[string compare $cmd ""]} {

		catch {consoleinterp eval $cmd} cmd

	    }

	    .console delete promptEnd end

	    .console insert promptEnd $cmd {input stdin}

    	}

    	reset {

    	    set HistNum 1

    	}

    }

}

# ::tk::ConsolePrompt --

# This procedure draws the prompt.  If tcl_prompt1 or tcl_prompt2

# exists in the main interpreter it will be called to generate the 

# prompt.  Otherwise, a hard coded default prompt is printed.

#

# Arguments:

# partial -	Flag to specify which prompt to print.

proc ::tk::ConsolePrompt {{partial normal}} {

    set w .console

    if {[string equal $partial "normal"]} {

	set temp [$w index "end - 1 char"]

	$w mark set output end

    	if {[consoleinterp eval "info exists tcl_prompt1"]} {

    	    consoleinterp eval "eval \[set tcl_prompt1\]"

    	} else {

    	    puts -nonewline [EvalAttached $::tk::console::defaultPrompt]

    	}

    } else {

	set temp [$w index output]

	$w mark set output end

    	if {[consoleinterp eval "info exists tcl_prompt2"]} {

    	    consoleinterp eval "eval \[set tcl_prompt2\]"

    	} else {

	    puts -nonewline "> "

    	}

    }

    flush stdout

    $w mark set output $temp

    ::tk::TextSetCursor $w end

    $w mark set promptEnd insert

    $w mark gravity promptEnd left

    ::tk::console::ConstrainBuffer $w $::tk::console::maxLines

    $w see end

}

# ::tk::ConsoleBind --

# This procedure first ensures that the default bindings for the Text

# class have been defined.  Then certain bindings are overridden for

# the class.

#

# Arguments:

# None.

proc ::tk::ConsoleBind {w} {

    bindtags $w [list $w Console PostConsole [winfo toplevel $w] all]

    ## Get all Text bindings into Console

    foreach ev [bind Text] { bind Console $ev [bind Text $ev] }	

    ## We really didn't want the newline insertion...

    bind Console <Control-Key-o> {}

    ## ...or any Control-v binding (would block <<Paste>>)

    bind Console <Control-Key-v> {}

    # For the moment, transpose isn't enabled until the console

    # gets and overhaul of how it handles input -- hobbs

    bind Console <Control-Key-t> {}

    # Ignore all Alt, Meta, and Control keypresses unless explicitly bound.

    # Otherwise, if a widget binding for one of these is defined, the

    bind Console <Alt-KeyPress> {# nothing }

    bind Console <Meta-KeyPress> {# nothing}

    bind Console <Control-KeyPress> {# nothing}

    foreach {ev key} {

	<<Console_Prev>>		<Key-Up>

	<<Console_Next>>		<Key-Down>

	<<Console_NextImmediate>>	<Control-Key-n>

	<<Console_PrevImmediate>>	<Control-Key-p>

	<<Console_PrevSearch>>		<Control-Key-r>

	<<Console_NextSearch>>		<Control-Key-s>

	<<Console_Expand>>		<Key-Tab>

	<<Console_Expand>>		<Key-Escape>

	<<Console_ExpandFile>>		<Control-Shift-Key-F>

	<<Console_ExpandProc>>		<Control-Shift-Key-P>

	<<Console_ExpandVar>>		<Control-Shift-Key-V>

	<<Console_Tab>>			<Control-Key-i>

	<<Console_Tab>>			<Meta-Key-i>

	<<Console_Eval>>		<Key-Return>

	<<Console_Eval>>		<Key-KP_Enter>

	<<Console_Clear>>		<Control-Key-l>

	<<Console_KillLine>>		<Control-Key-k>

	<<Console_Transpose>>		<Control-Key-t>

	<<Console_ClearLine>>		<Control-Key-u>

	<<Console_SaveCommand>>		<Control-Key-z>

    } {

	event add $ev $key

	bind Console $key {}

    }

    bind Console <<Console_Expand>> {

	if {[%W compare insert > promptEnd]} {::tk::console::Expand %W}

    }

    bind Console <<Console_ExpandFile>> {

	if {[%W compare insert > promptEnd]} {::tk::console::Expand %W path}

    }

    bind Console <<Console_ExpandProc>> {

	if {[%W compare insert > promptEnd]} {::tk::console::Expand %W proc}

    }

    bind Console <<Console_ExpandVar>> {

	if {[%W compare insert > promptEnd]} {::tk::console::Expand %W var}

    }

    bind Console <<Console_Eval>> {

	%W mark set insert {end - 1c}

	tk::ConsoleInsert %W "\n"

	tk::ConsoleInvoke

	break

    }

    bind Console <Delete> {

	if {[string compare {} [%W tag nextrange sel 1.0 end]] \

		&& [%W compare sel.first >= promptEnd]} {

	    %W delete sel.first sel.last

	} elseif {[%W compare insert >= promptEnd]} {

	    %W delete insert

	    %W see insert

	}

    }

    bind Console <BackSpace> {

	if {[string compare {} [%W tag nextrange sel 1.0 end]] \

		&& [%W compare sel.first >= promptEnd]} {

	    %W delete sel.first sel.last

	} elseif {[%W compare insert != 1.0] && \

		[%W compare insert > promptEnd]} {

	    %W delete insert-1c

	    %W see insert

	}

    }

    bind Console <Control-h> [bind Console <BackSpace>]

    bind Console <Home> {

	if {[%W compare insert < promptEnd]} {

	    tk::TextSetCursor %W {insert linestart}

	} else {

	    tk::TextSetCursor %W promptEnd

	}

    }

    bind Console <Control-a> [bind Console <Home>]

    bind Console <End> {

	tk::TextSetCursor %W {insert lineend}

    }

    bind Console <Control-e> [bind Console <End>]

    bind Console <Control-d> {

	if {[%W compare insert < promptEnd]} break

	%W delete insert

    }

    bind Console <<Console_KillLine>> {

	if {[%W compare insert < promptEnd]} break

	if {[%W compare insert == {insert lineend}]} {

	    %W delete insert

	} else {

	    %W delete insert {insert lineend}

	}

    }

    bind Console <<Console_Clear>> {

	## Clear console display

	%W delete 1.0 "promptEnd linestart"

    }

    bind Console <<Console_ClearLine>> {

	## Clear command line (Unix shell staple)

	%W delete promptEnd end

    }

    bind Console <Meta-d> {

	if {[%W compare insert >= promptEnd]} {

	    %W delete insert {insert wordend}

	}

    }

    bind Console <Meta-BackSpace> {

	if {[%W compare {insert -1c wordstart} >= promptEnd]} {

	    %W delete {insert -1c wordstart} insert

	}

    }

    bind Console <Meta-d> {

	if {[%W compare insert >= promptEnd]} {

	    %W delete insert {insert wordend}

	}

    }

    bind Console <Meta-BackSpace> {

	if {[%W compare {insert -1c wordstart} >= promptEnd]} {

	    %W delete {insert -1c wordstart} insert

	}

    }

    bind Console <Meta-Delete> {

	if {[%W compare insert >= promptEnd]} {

	    %W delete insert {insert wordend}

	}

    }

    bind Console <<Console_Prev>> {

	tk::ConsoleHistory prev

    }

    bind Console <<Console_Next>> {

	tk::ConsoleHistory next

    }

    bind Console <Insert> {

	catch {tk::ConsoleInsert %W [::tk::GetSelection %W PRIMARY]}

    }

    bind Console <KeyPress> {

	tk::ConsoleInsert %W %A

    }

    bind Console <F9> {

	eval destroy [winfo child .]

	if {[string equal $tcl_platform(platform) "macintosh"]} {

	    if {[catch {source [file join $tk_library console.tcl]}]} {source -rsrc console}

	} else {

	    source [file join $tk_library console.tcl]

	}

    }

    if {[string equal $::tcl_platform(platform) "macintosh"]

	   || [string equal [tk windowingsystem] "aqua"]} {

	    bind Console <Command-q> {

		exit

	    }

    }

    bind Console <<Cut>> {

        # Same as the copy event

 	if {![catch {set data [%W get sel.first sel.last]}]} {

	    clipboard clear -displayof %W

	    clipboard append -displayof %W $data

	}

    }

    bind Console <<Copy>> {

 	if {![catch {set data [%W get sel.first sel.last]}]} {

	    clipboard clear -displayof %W

	    clipboard append -displayof %W $data

	}

    }

    bind Console <<Paste>> {

	catch {

	    set clip [::tk::GetSelection %W CLIPBOARD]

	    set list [split $clip \n\r]

	    tk::ConsoleInsert %W [lindex $list 0]

	    foreach x [lrange $list 1 end] {

		%W mark set insert {end - 1c}

		tk::ConsoleInsert %W "\n"

		tk::ConsoleInvoke

		tk::ConsoleInsert %W $x

	    }

	}

    }

    ##

    ## Bindings for doing special things based on certain keys

    ##

    bind PostConsole <Key-parenright> {

	if {[string compare \\ [%W get insert-2c]]} {

	    ::tk::console::MatchPair %W \( \) promptEnd

	}

    }

    bind PostConsole <Key-bracketright> {

	if {[string compare \\ [%W get insert-2c]]} {

	    ::tk::console::MatchPair %W \[ \] promptEnd

	}

    }

    bind PostConsole <Key-braceright> {

	if {[string compare \\ [%W get insert-2c]]} {

	    ::tk::console::MatchPair %W \{ \} promptEnd

	}