#########################################################################
# tk.tcl - tk 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 mmucl_tk.tcl]

proc mmucl::display {str} {
    variable Mmucl

    .display configure -state normal
    set ypos [lindex [.display yview] 1]

    foreach part [split $str \033] {
	if {[regexp -- $Mmucl(rxp,ansi_parse) $part x codes text]} {
	    foreach code [split $codes \;] {
		if {$code == 0 || [string equal $code ""]} {
		    set Mmucl(ansi_tags) [list "" "" ""]
		} elseif {$code < 8} {
		    set Mmucl(ansi_tags) \
			    [lreplace $Mmucl(ansi_tags) 0 0 $code]
		} elseif {$code < 40} {
		    set Mmucl(ansi_tags) \
			    [lreplace $Mmucl(ansi_tags) 1 1 $code]
		} else {
		    set Mmucl(ansi_tags) \
			    [lreplace $Mmucl(ansi_tags) 2 2 $code]
		}
	    }
	} else {
	    set text $part
	}
	.display insert end $text $Mmucl(ansi_tags)
    }

    if {$ypos == 1} {
    	.display see end
    }
    
    if {[.display index end] > 500} {
        .display delete 1.0 50.0
    }
    
    .display configure -state disabled
    
    return
}

proc mmucl::interface_init {} {
    variable Mmucl
    global config

    array set Mmucl {
	ansi_tags {{} 37 40}
	rxp,ansi_parse {^\[([0-9;]*)m(.*)$}
    }
    
    gui_init

    menu .menubar
    .menubar add cascade -label File -menu .menubar.file -underline 0
    .menubar add cascade -label Edit -menu .menubar.edit -underline 0
    .menubar add cascade -label "Tk Config" -menu .menubar.tkconf -underline 0
    .menubar add cascade -label Options -menu .menubar.options -underline 0
    .menubar add cascade -label Help -menu .menubar.help -underline 0
    
    menu .menubar.file
    
    .menubar.file add command -label Connect -command mmucl::tk_connect
    .menubar.file add separator
    .menubar.file add command -label Load -command mmucl::tk_source
    .menubar.file add command -label Send -command mmucl::tk_textin
    .menubar.file add command -label Save -command mmucl::tk_dump
    .menubar.file add separator
    .menubar.file add command -label Exit -command mmucl::tk_exit
    
    menu .menubar.edit
    
    .menubar.edit add command -label Copy \
	    -command {event generate .display <<Copy>>}
    .menubar.edit add command -label Paste \
	    -command {event generate .input <<Paste>>}
    .menubar.edit add separator
    .menubar.edit add command -label Aliases -command {mmucl::tk_edit alias}
    .menubar.edit add command -label Actions -command {mmucl::tk_edit action}
    .menubar.edit add command -label Chars -command {mmucl::tk_edit char}
    .menubar.edit add command -label Keys -command {mmucl::tk_edit key}
    .menubar.edit add command -label Subs -command {mmucl::tk_edit sub}

    menu .menubar.tkconf
    
    .menubar.tkconf add command -label Default -command \
	    "tkconf::init [file join $config(lib_dir) .tkconf]; tkconf::apply"
    .menubar.tkconf add command -label Save -command \
	    [list tkconf::save [file join $config(rc_dir) .tkconf]]
    .menubar.tkconf add command -label Edit -command {tkconf::dialog }

    mmucl::option_menu .menubar.options
    
    menu .menubar.help
    
    .menubar.help add command -label About -command {mmucl::MChelp About}
    .menubar.help add command -label Tutorial -command {mmucl::MChelp Tutorial}
    .menubar.help add command -label Commands -command \
	    {mmucl::MChelp Procedures}
    .menubar.help add command -label Contents -command {mmucl::MChelp}
    
    . configure -menu .menubar
    
    mmucl::toolbar .toolbar
    mmucl::user_entry .input

    bind .input <Next> {.display yview scroll 1 page; break}
    bind .input <Prior> {.display yview scroll -1 page; break}
    bind .input <Home> {.display see 1.0}
    bind .input <Key> {+.display see end}
    
    text .display -state disabled -yscrollcommand {.vscroll set}
    scrollbar .vscroll -orient vertical -command {.display yview}
    
    grid .toolbar -row 0 -column 0  -sticky ew
    grid .display -row 1 -column 0 -sticky news
    grid .vscroll -row 1 -column 1 -sticky ns
    grid .input -row 2 -column 0 -columnspan 1 -sticky news
    grid columnconfigure . 0 -weight 1
    grid rowconfigure . 1 -weight 1

    tkconf::apply
    
    # needed to make selection visible.
    .display tag raise sel
    
    focus .input
    
    rename interface_init ""
    return
}
