#!/usr/bin/wish
# $Id$
#

set fontFamily lucidatypewriter 
set fontSize 17
set w ""
set t [text $w.t -yscrollcommand "$w.sb set" \
	-background gray95 -foreground black \
	-state disabled -font "$fontFamily $fontSize"]
set sb [scrollbar $w.sb -orient vertical -command "$w.t yview"]
set e [entry $w.e -font "$fontFamily $fontSize" \
	-background white -foreground black]

pack $e -side bottom -fill x -expand no
pack $sb -side right -fill y -expand no
pack $t -fill both -expand yes

focus $e
bind $e <Key-Return> { enter }
bind $e <Control-Key-c> { controlc }
bind $e <Control-Key-d> { controld }
bind $e <Key-Up> { history up }
bind $e <Key-Down> { history down }
bind $e <Key-Next> { $t yview scroll 1 page }
bind $e <Key-Prior> { $t yview scroll -1 page }

set cmdrunning 0
set tc 0
set history_list {}
set history_pos end

proc history { dir } {
    global history_list history_pos e
    set history_len [llength $history_list]
    if {$history_pos == "end"} {
	set history_pos $history_len
    }
    switch $dir {
	up { set history_pos [expr $history_pos - 1] }
	down { set history_pos [expr $history_pos + 1] }
    }
    if {$history_pos < 0} { set history_pos 0 }
    if {$history_pos >= $history_len} { set history_pos $history_len }
    $e delete 0 end
    $e insert 0 [lindex $history_list $history_pos]
}

proc addstr { str color } {
    global t tc
    set tstart [$t index "end - 1 chars"]
    $t configure -state normal
    $t insert end "$str\n"
    $t configure -state disabled
    $t tag add in$tc $tstart "end - 2 chars"
    $t tag configure in$tc -foreground $color
    incr tc
}

proc msg { str } {
    addstr $str Red
}

proc echo { intext } {
    addstr $intext Green
}

proc echoinput { intext } {
    addstr $intext Blue
}

proc controlc {} {
    msg "^C"
    catch {
	global handle
	foreach p [pid $handle] {
	    exec kill -15 $p
	}
    }
}

proc controld {} {
    msg "EOF"
    catch {
	global handle cmdrunning
	close $handle
	set cmdrunning 0
    }
}

set tc 0 ;# Tag counter

proc fixformatting { t fb fe } {
  set re "(.\b.)+"
  set mc 0		;# matched characters
  set p [$t search -count mc -regexp $re $fb $fe]
  while {$mc > 0} {
    switch -- [$t get $p] {
      "_"     { set style underline }
      default { set style bold }
    }
    # Remove the extra characters
    set dt [$t get $p "$p + $mc chars"]
    regsub -all ".\b(.)" $dt {\1} ft
    $t delete $p "$p + $mc chars"
    $t insert $p $ft
    # The length of the range is now 1/3 of the original
    set len [expr $mc / 3]
    global tc fontFamily fontSize
    set n f$tc
    $t tag add $n $p "$p + $len chars"
    set tc [expr $tc + 1]
    $t tag configure $n -font "$fontFamily $fontSize $style"
    set newindex "$p + $len chars"
    set mc 0
    set p [$t search -count mc -regexp $re $newindex $fe]
  }
}

proc cmdout {} {
    global t handle
    $t configure -state normal
    set fixbegin [$t index end]
    $t insert end [read $handle]
    fixformatting $t $fixbegin [$t index end]
    $t configure -state disabled
    $t see end
    if {[eof $handle]} {
        catch {close $handle}
        global cmdrunning
        set cmdrunning 0
	msg "External command completed."
    }
}

proc cmdin {} {
    global e handle
    echoinput [$e get]
    puts $handle [$e get]
    $e delete 0 end
}

proc run {} {
    global e t history_list history_pos
    set rawcmd [$e get]
    if [info complete $rawcmd] {
	msg "Running: $rawcmd"
	$t configure -state normal
	if {[llength [info commands [lindex $rawcmd 0]]] == 0} {
	    set external 1
	    eval $rawcmd
	} else {
	    set external 0
	    $t insert end [uplevel #0 eval $rawcmd]\n
	    msg "Tcl command completed."
	}
	$e delete 0 end
	lappend history_list $rawcmd
	set history_pos end
	$t see end
	$t configure -state disabled
    } else {
	msg "The command is incomplete"
    }
}

proc unknown { name args } {
    global handle
    set exp_cmd [list $name]
    foreach word $args {
	if [catch {glob $word} g] {
	    lappend exp_cmd $word
	} else {
	    lappend exp_cmd $g
	}
    }
    set j [join $exp_cmd]
    set handle [open |$j r+]
    fconfigure $handle -blocking no -buffering line
    fileevent $handle readable cmdout
    global cmdrunning
    set cmdrunning 1
}

proc enter {} {
    global cmdrunning
    switch -- $cmdrunning {
        0 { run }
        1 { cmdin }
    }
}
# vim:sw=4 ai sm