#####################################################################
# console.tcl - console interface
#
# Copyright (C) 1997-1999 Mark Patton
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#####################################################################

source [file join $config(lib_dir) lib term.tcl]

proc mmucl::display {str} {
    variable Mmucl
    
    term::restore_pos
    puts -nonewline $str
    term::save_pos
    term::goto_rowcol $Mmucl(lines) [expr {[term::rl_cursor] + 1}]
    
    return
}

proc mmucl::MCterm_reset {} {
    variable Mmucl
    
    term::reset
    term::erase_screen
    term::scroll_region 1 [expr {$Mmucl(lines) - 2}]
    term::goto_rowcol [expr {$Mmucl(lines) - 2}] 1
    term::save_pos
    term::goto_rowcol [expr {$Mmucl(lines) - 1}] 1
    puts \033\[1m-----
    term::goto_rowcol $Mmucl(lines) [expr {[term::rl_cursor] + 1}]
}

proc mmucl::console_parse {input} {
    variable Mmucl
    
    if {$Mmucl(cfg,keep_line)} {
	puts -nonewline \n[MCcolor $input bg_magenta]
        term::rl_clearonhit 1
   } else {
	term::rl_goto_beg
	term::rl_clear_toend
    }
    
    if {$Mmucl(cfg,echo)} {
	MCecho [MCcolor $input $Mmucl(cfg,echo_color)]
    }
    
    if {[catch {MCparse $input} val]} {
	report error $val
    } elseif {[string length $val]} {
	MCecho $val
    }
    
    if {[string length $input] >= $Mmucl(cfg,hist_min)} {
	term::rl_hist_add $input $Mmucl(cfg,hist_keep)
    }
    
    return
}

proc mmucl::MChelp {{subject ""}} {
    exec info (mmucl)$subject <@stdin >@stdout
    MCterm_reset
}

proc mmucl::MCcline {args} {
    variable Mmucl

    set syntax {
	delete {{? first 0} {? last end}}
	get {{? first 0} {? last end}} 
	insert {{+ first} {+ str}}
	history {}
    }
    
    set opt [check cline $syntax $args 1]
    set line [term::rl_get]

    foreach index [list arg(first) arg(last)] {
	if ([info exists $index]) {
	    if {[string equal [set $index] end]} {
		set $index [expr {[string length $line] - 1}]
	    } elseif {[string equal [set $index] insert]} {
		set $index [term::rl_cursor]
	    } elseif {[catch {incr $index 0}]} {
		error "bad index [set $index]: must be number, insert, or end"
	    }
	}
    }

    switch -exact $opt {
        delete {
	    set new [string range $line 0 [incr arg(first) -1]]
	    append new [string range $line [incr arg(last) 1] end]
	    term::rl_set $new
	} get {
	    return [string range $line $arg(first) $arg(last)]
	} insert {
	    term::rl_set_cursor $arg(first)
	    for {set i 0} {$i < [string length $arg(str)]} {incr i} {
		term::rl_insert [string index $arg(str) $i]
	    }
	} history {
	    return [term::rl_history]
	}
    }
    
    return
}

# this doesn't actually do anything :)
proc mmucl::MCkey {args} {
    variable key

    set syntax {
	 set      {{+ key} {? script}}
	 names    {{? pattern *}}
	 print    {{? pattern *}}
	 delete   {{- exact} {+ pattern}}
     }
     
     switch [check key $syntax $args 1] {
	 set {
	     if {[info exists arg(script)]} {
		 set key($arg(key)) $arg(script)
	     } elseif {![info exist key($arg(key))]} {
		 error "no such key"
	     } else {
		 return $key($arg(key))
	     }
	 } names {
	     return [array names key $arg(pattern)]
	 } delete {
	     if {[info exists arg(-exact)]} {
		 unset key($arg(pattern))
	     } else {
		 foreach k [array names key $arg(pattern)] {
		     unset key($k)
		 }
	     }
	 } print {
	     foreach k [array names key $arg(pattern)] {
		 MCecho "$k bound to {$key($key)}"
	     }
	 }
     }
    
    return
}

proc mmucl::MCbell {} {
    term::bell
    return
}

proc mmucl::interface_init {} {
    variable Mmucl

    set Mmucl(lines) [term::rows]

    term::rl_loop mmucl::console_parse
    MCterm_reset

    rename interface_init ""
    return
}
