#########################################################################
# tk.tcl - tk interface
#
# Copyright (C) 1997-2002 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.
#########################################################################

# display text widget - .display$ses
# display scrollbar - .vscroll$ses
# input text widget - .input
# menubar - .menubar
# session buttons - .ses.$ses
# bindtag class for handling MCkey - mmucl$ses 
# .status status bar

proc mmucl::display {ses str} {
    variable Mmucl

    if {$ses != $Mmucl(cur)} {
	session_button_color $ses blue3
    }

    set w .display$ses

    $w configure -state normal
    set ypos [lindex [$w yview] 1]

    foreach part [split $str \033] {
	if {[regexp -- $Mmucl(rxp,ansi_parse) $part x codes text]} {
	    foreach code [split $codes \;] {
		if {$code == 0 || $code eq ""} {
		    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
	}

	$w insert end $text $Mmucl(ansi_tags)
    }

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

proc mmucl::event {ses event args} {
    variable Mmucl

    set host $Mmucl(ses,$ses,host)

    switch -exact $event {
	attempt {
	    session_button_color $ses yellow2
	} connect {
	    session_status $ses "connected: $host"
	    session_button_color $ses green4
	    set Mmucl(ses,$ses,connect_time) [clock seconds]
	    after 60000 mmucl::update_connect_time $ses
	} disconnect {
	    session_button_color $ses red3
	    session_status $ses disconnected
	} timeout {
	    session_button_color $ses red3
	    session_status $ses disconnected
	} ses_new {
	    lassign {old_ses} $args

	    session_added
	    session_switched $old_ses
	} ses_switch {
	    lassign {old_ses} $args

	    session_switched $old_ses
	    session_status $Mmucl(cur) $Mmucl(ses,$ses,status)

	    if {$host ne ""} {
		if {$Mmucl(ses,$Mmucl(cur),connect)} {
		    session_button_color $ses green4
		} else {
		    session_button_color $ses red3
		}
	    }
	} ses_close {
	    lassign {old_ses} $args

	    session_switched $old_ses

	    destroy .ses.$old_ses
	    destroy .display$old_ses
	    destroy .vscroll$old_ses

	    if {[llength $Mmucl(sessions)] == 1} {
		grid remove .ses
	    }

	} default {
	    error "event $event not understood"
	}
    }
}

proc mmucl::session_status {ses msg} {
    variable Mmucl

    set Mmucl(ses,$ses,status) $msg

    if {$ses == $Mmucl(cur)} {
	wm title . "Mmucl - $msg"

	if {$Mmucl(ses,$ses,connect_duration) ne ""} {
	    append msg " \[" $Mmucl(ses,$ses,connect_duration) \]
	}

	if {$Mmucl(ses,$ses,user_status) ne ""} {
	    append msg " \{" $Mmucl(ses,$ses,user_status) \}
	}

	.status configure -text $msg
    }
}

proc mmucl::MCclear {ses args} {
    variable Mmucl

    set syntax {}
    check clear $syntax $args

    set w .display$ses
    $w configure -state normal
    $w delete 1.0 end
    $w configure -state disabled
}

proc mmucl::MCstatus {ses args} {
    variable Mmucl

    set syntax {{+ text}}
    check status $syntax $args

    set Mmucl(ses,$ses,user_status) $arg(text)
    session_status $ses $Mmucl(ses,$ses,status)
}

proc mmucl::session_button_color {ses color} {
    variable Mmucl

    .ses.$ses configure -text [ses_name $ses] -foreground $color \
	    -activeforeground $color
}

proc mmucl::session_switched {old_ses} {
    variable Mmucl

    set ses $Mmucl(cur)

    .ses.$old_ses configure -relief sunken
    .ses.$ses configure -relief raised
    
    grid remove .display$old_ses
    grid remove .vscroll$old_ses
    grid .display$ses
    grid .vscroll$ses

    bindtags $Mmucl(entry) \
	    [lreplace [bindtags $Mmucl(entry)] 0 0 mmucl$ses]
}

proc mmucl::update_connect_time {ses} {
    variable Mmucl

    if {[info exists Mmucl(ses,$ses,connect)] && $Mmucl(ses,$ses,connect)} {
	set host $Mmucl(ses,$ses,host)
	set time [expr {[clock seconds] - $Mmucl(ses,$ses,connect_time)}]
		set Mmucl(ses,$ses,connect_duration) [duration $time]

	session_status $ses $Mmucl(ses,$ses,status)
	after 60000 mmucl::update_connect_time $ses
    }
}

proc balloon_add {w message} {
    bind $w <Enter> [list after 500 balloon_draw $w [list $message]]
    bind $w <Leave> [namespace code [list balloon_erase $w $message]]\
}

proc balloon_draw {w message} {
    balloon_erase $w $message

    toplevel .balloon -class Balloon -borderwidth 1 -relief ridge -bg black
    wm overrideredirect .balloon 1
    label .balloon.l -text $message -bg #fffeca
    pack .balloon.l
    wm geometry .balloon +[expr {[winfo rootx $w]+[winfo width $w]/2}]+[expr {[winfo rooty $w]+[winfo height $w]}]
}

proc balloon_erase {w message} {
    after cancel [list balloon_draw $w $message]
    destroy .balloon
}

proc mmucl::MCbell {ses} {
    variable Mmucl

    bell
}

# Create an entry that expands if input reaches the end
proc mmucl::user_entry {w} {
    variable Mmucl
    
    text $w -height 1 -wrap char

    set Mmucl(entry) $w
    set Mmucl(entry_fg) [$w cget -foreground]

    bind $w <Key-Return> {mmucl::user_entry_parse %W; break}
    bind $w <Key-Up> {mmucl::user_entry_scroll_up %W; break}
    bind $w <Key-Down> {mmucl::user_entry_scroll_down %W; break}
    bind $w <KeyRelease> {mmucl::user_entry_check_expand %W}
    bindtags $w [linsert [bindtags $w] 0 mmucl$Mmucl(cur)]

    return $w 
}

proc mmucl::user_entry_check_expand {w} {
    set offset [string length [$w get 1.0 "end -1 chars"]]
    set row [expr {($offset / [$w cget -width]) + 1}]
    set height [$w cget -height]

    if {$row < $height || $row > $height} {
	$w configure -height $row
    }
}

proc mmucl::user_entry_parse {w} {
    variable Mmucl

    meta_parse [$w get 1.0 "end -1 chars"]
    
    if {$Mmucl(cfg,keep_line)} {
	$w tag add sel 1.0 1.end
    } else {
	$w delete 1.0 end
    }
}

proc mmucl::user_entry_scroll_up {w} {
    variable Mmucl

    if {$Mmucl(hist_loc)} {
	if {$Mmucl(hist_loc) == [llength $Mmucl(history)]} {
	    set Mmucl(hist_cur) [$w get 1.0 "end -1 chars"]
	}	
	$w delete 1.0 end
	$w insert 1.0 [lindex $Mmucl(history) [incr Mmucl(hist_loc) -1]]
    }

    return
}

proc mmucl::user_entry_scroll_down {w} {
    variable Mmucl
    
    if {[incr Mmucl(hist_loc)] > [llength $Mmucl(history)]} {
	incr Mmucl(hist_loc) -1
    } else {
	$w delete 1.0 end
	if {$Mmucl(hist_loc) == [llength $Mmucl(history)]} {
	    $w insert 1.0 $Mmucl(hist_cur)
	} else {
	    $w insert 1.0 [lindex $Mmucl(history) $Mmucl(hist_loc)]
	}
    }

    return
}

proc mmucl::tk_script {script descript} {
    global errorInfo
    variable Mmucl

    if {[catch $script error]} {
	report $Mmucl(cur) error "$error\nStack trace:\n$::errorInfo"
	tk_messageBox -icon error -message "Error: $descript\n$error" -type ok
	return 0
    }

    return 1
}

# ugly
proc mmucl::tk_connect {} {
    variable Mmucl
    
    set ses $Mmucl(cur)

    if {[winfo exists .con]} {
	raise .con
	return
    }
    
    toplevel .con
    wm title .con Connect

    frame .con.f -relief groove -bd 2
    grid [label .con.f.hostl -text Host:]
    grid [entry .con.f.host] -row 0 -column 1
    grid [label .con.f.portl -text Port:] 
    grid [entry .con.f.port] -row 1 -column 1
 
    .con.f.host insert end $Mmucl(ses,$ses,host)
    .con.f.port insert end $Mmucl(ses,$ses,port)

    if {![info exists Mmucl(tmpchar)]} {
	set Mmucl(tmpchar) ""
    }

    # if characters defined, make a character selection area
    if {[llength [set chars [lsort [MCchar $ses names]]]]} {
	grid [label .con.f.lchar -text Char:]

        set m [eval tk_optionMenu .con.f.char mmucl::Mmucl(tmpchar) $chars]
	$m add separator
	$m add command -label None -command {set mmucl::Mmucl(tmpchar) ""}
	set Mmucl(tmpchar) ""

	grid .con.f.char -row 2 -column 1
	
	# hack to update host and port on char selection.
	bind $m <ButtonRelease> {
	    .con.f.host delete 0 end
	    .con.f.port delete 0 end
	    
	    after 10 {
		if {![string equal $mmucl::Mmucl(tmpchar) ""]} {
		    .con.f.host insert 0 \
			[lindex [mmucl::MCchar $mmucl::Mmucl(cur) set $mmucl::Mmucl(tmpchar)] 0]
		    .con.f.port insert 0 \
			[lindex [mmucl::MCchar $mmucl::Mmucl(cur) set $mmucl::Mmucl(tmpchar)] 1]
		}
	    }
	}
    }
    
    frame .con.b
    pack [button .con.b.ok -text Connect \
	    -command mmucl::tk_connect_do] -side left
    pack [button .con.b.quit -text Cancel -command {destroy .con}] -side left
  
    pack .con.f .con.b
    wm geometry .con +[winfo pointerx .]+[winfo pointery .]
    wm resizable .con 0 0

    return
}

proc mmucl::tk_connect_do {} {
    variable Mmucl

    if {![string equal $Mmucl(tmpchar) ""]} {
	set res [tk_script [list MCchar $Mmucl(cur) load $Mmucl(tmpchar)] "Loading char"]
    } else {
	set res [tk_script [list MCconnect $Mmucl(cur) [.con.f.host get]\
		[.con.f.port get]] "Connecting to host"]
    }
    
    if {$res} {
	destroy .con
    }

    return
}

proc mmucl::tk_edit {proc} {
    variable Mmucl

    set list 0
    switch -exact -- $proc {
	action {
	    set labels {Pattern: Script:}
	    set title "Edit Actions"
	} alias {
	    set labels {Name: Script:}
	    set title "Edit Aliases"
	} sub {
	    set labels {Pattern: Subspec:}
	    set title "Edit Subs"
	} key {
	    set labels {Event: Script:}
	    set title "Edit Keys"
	} char {
	    set labels {Name: Host: Port: Login:}
	    set title "Edit Characters"
	    set list 1
	}
    }

    set w .$proc

    if {[winfo exists $w]} {
	raise $w
	return
    }

    toplevel $w
    wm title $w "Mmucl - $title"
    wm group $w .
    wm transient $w .

    form $w.form $labels MC$proc $list
    pack $w.form -side top -pady 3
 
    frame $w.b
    pack [button $w.b.help -text Help -command [list mmucl::MChelp $Mmucl(cur) $proc]]\
	    [button $w.b.exit -text Close -command [list destroy $w]] \
	    -side left
    pack $w.b -side bottom
    
    wm geometry $w +[winfo pointerx .]+[winfo pointery .]
    wm resizable $w 0 0

    return
}


# evaluate a script bound to a key

proc mmucl::key_eval {ses group key cur_key} {
    variable Mmucl

    set Mmucl(ses,$ses,current_key) $cur_key
    set script [group_member_get $ses $group key $key]
    set code [catch {$ses eval $script} error]

    if {$code} {
	if {$code == 3} {
	    return -code break
	}
	
	report $ses error "key $key: $error"
    }
}

proc mmucl::tk_key_event {id} {
    if {[string match *-* $id]} {
	regsub -- - $id -Key- event
	set event <$event>
    } else {
	set event <$id>
    }

    return $event
}


proc mmucl::key_set_hook {ses group key val arglist} {
    key_validate $key
    bind mmucl$ses [tk_key_event $key] \
	[list mmucl::key_eval $ses $group $key %K]
}

proc mmucl::key_delete_hook {ses group key} {
    bind mmucl$ses [tk_key_event $key] {}
}


proc mmucl::MChelp {cur {subject ""}} {
    global config ntki_embed

    if {![info exists ntki_embed]} {
	set ntki_embed 1
	uplevel #0 [list source [file join $config(lib_dir) lib ntkinfo.tcl]]
	ntki::init
    }
    
    ntki::win (mmucl)$subject
}

# Modify the command line.

proc mmucl::MCcline {cur args} {
    variable Mmucl

    set w $Mmucl(entry)
    set syntax {
	delete {{? first 0} {? last end}}
	get {{? first 0} {? last end}} 
	insert {{+ first} {+ str}}
	history {}
	hide {{? bool 1}}
    }

    set opt [check cline $syntax $args 1]

    foreach index {arg(first) arg(last)} {
	if {![info exists $index]} {
	    continue
	}

	if {[string equal [set $index] insert]} {
	    continue;
	} elseif {[string equal [set $index] end]} {
	    set $index 1.end
	} elseif {[string is int -strict [set $index]]} {
	    set $index 1.[set $index]
	} else {
	    error "bad index"
	}
    }

    switch -exact $opt {
        delete {
	    $w delete $arg(first) $arg(last)
	} get {
	    return [$w get $arg(first) $arg(last)]
	} insert {
	    $w insert $arg(first) $arg(str)
	} history {
	    return $Mmucl(history)
	} hide {
	    if {$arg(bool)} {
		$w configure -foreground [$w cget -background]
	    } else {
		$w configure -foreground $Mmucl(entry_fg)
	    }
	}
    }
}

proc mmucl::tk_source {} {
    variable Mmucl

    set file [tk_getOpenFile -title "Load a file"]
    
    if {$file ne ""} {
	tk_script [list $Mmucl(cur) invokehidden source $file] \
		"Loading script"
    }
}

proc mmucl::tk_textin {} {
    variable Mmucl

    set file [tk_getOpenFile -title "Send a file"]
    
    if {$file ne ""} {
	tk_script [list MCtextin $Mmucl(cur) $file] "Sending file"
    }
}

proc mmucl::tk_dump {} {
    variable Mmucl

    set file [tk_getSaveFile -title "Save state to file"]
   
    if {$file ne ""} {
	tk_script [list MCdump $Mmucl(cur) -all -- $file] "Saving state"
    }
}

proc mmucl::form {w labels proc list} {
    frame $w -class Form
    frame $w.sel
    pack [listbox $w.sel.list -yscroll [list $w.sel.yscroll set]] \
	    -fill y -expand 1 -side left
    pack [scrollbar $w.sel.yscroll -command [list $w.sel.list yview]] \
	      -side left -expand 1 -fill y

    frame $w.edit
    frame $w.edit.buts
    pack [button $w.edit.buts.add -text Add \
	      -command [list mmucl::form_add $w $proc $list]] -side left
    pack [button $w.edit.buts.delete -text Delete \
	      -command [list mmucl::form_delete $w $proc]] -side left
    frame $w.edit.f
    
    set i 0
    foreach label $labels {
	grid [label $w.edit.f.l$i -text $label] -sticky w -column 0

	if {$label eq "Script:"} {
	    grid [text $w.edit.f.e$i -width 60 -height 20\
		    -yscroll [list $w.edit.f.yscroll$i set]] \
		    -row $i -sticky ew -column 1
	    grid [scrollbar $w.edit.f.yscroll$i \
		    -command [list $w.edit.f.e$i yview]] -sticky ns -row $i \
		    -column 2
	} else {
	    grid [entry $w.edit.f.e$i] -row $i -sticky ew -column 1
	}

	incr i
    }
    
    pack $w.edit.f $w.edit.buts -side top
    pack $w.sel -expand 1 -side left -fill y
    pack $w.edit -side left
   
    set e $w.edit.f.e[incr i -1]
    if {[winfo class $e] eq "Entry"} {
	bind $e <Key-Return> [list mmucl::form_add $w $proc $list]
    }

    bind $w.sel.list <ButtonRelease-1> \
	[list mmucl::form_show_selection $w $proc $list]

    form_listbox_update $w $proc

    return $w
}

proc mmucl::form_show_selection {w proc list} {
    variable Mmucl

    set i [$w.sel.list curselection]

    if {$i ne ""} {
	set i [$w.sel.list get $i]

	if {$list} {
	    form_set_entries $w [concat [list $i] [$proc $Mmucl(cur) set $i]]
	} else {
	    if {$proc eq "MCaction" || $proc eq "MCsub"} {
		form_set_entries $w [list $i [$proc $Mmucl(cur) set -- $i]]
	    } else {
		form_set_entries $w [list $i [$proc $Mmucl(cur) set $i]]
	    }
	}
    }
}

proc mmucl::form_add {w proc list} {
    variable Mmucl

    set e [form_get_entries $w]
    
    if {$list} {
	set script [list $proc $Mmucl(cur) set [lindex $e 0] [lrange $e 1 end]]
    } else {
	set script  [concat [list $proc $Mmucl(cur)] set $e]
    }

    # assumes MCname procs...
    tk_script $script "Adding [string range $proc 2 end]"
    form_listbox_update $w $proc
}

proc mmucl::form_delete {w proc} {
    variable Mmucl

    set i [$w.sel.list curselection]
    
    if {$i ne ""} {
	set i [$w.sel.list get $i]
	$proc $Mmucl(cur) delete -exact -- $i
	form_listbox_update $w $proc
    }
}

proc mmucl::form_listbox_update {w proc} {
    variable Mmucl

    form_set_entries $w {}

    $w.sel.list delete 0 end
    foreach i [lsort [$proc $Mmucl(cur) names]] {
        $w.sel.list insert end $i
    }
}

proc mmucl::form_get_entries {w} {
    set num_entries [expr {[llength [winfo children $w.edit.f]]/2}]

    for {set i 0} {$i < $num_entries} {incr i} {
	set e $w.edit.f.e$i

	if {[winfo class $e] eq "Text"} {
	    lappend list [$e get 1.0 end-1chars]
	} else {
	    lappend list [$e get]
	}
    }

    return $list
}

proc mmucl::form_set_entries {w list} {
    set num_entries [expr {[llength [winfo children $w.edit.f]] / 2}]

    for {set i 0} {$i < $num_entries} {incr i} {
	set e $w.edit.f.e$i
	
	if {[winfo class $e] eq "Text"} {
	    $e delete 1.0 end
	    $e insert end [lindex $list $i]
	} else {
	    $e delete 0 end
	    $e insert end [lindex $list $i]
	}
    }
}


proc mmucl::font_changed {} {
    variable Mmucl

    set font [list $Mmucl(pref,font,family) $Mmucl(pref,font,size)]
    .input configure -font $font

    foreach ses $Mmucl(sessions) {
	set w .display$ses
	$w configure -font $font
	$w tag configure 1 -font [lappend font bold]
    }
}

proc mmucl::tk_ses_new {} {
    variable Mmucl

    MCsession $mmucl::Mmucl(cur) new
}

proc mmucl::tk_ses_close {} {
    variable Mmucl

    tk_script {MCsession $Mmucl(cur) close $Mmucl(cur)} \
	    "Closing session $mmucl::Mmucl(cur)"
}

proc mmucl::font_family_menu {w} {
    variable Mmucl

    if {[$w index 0] eq "none"} {
	foreach name [lsort [font families]] {
	    if {[font metrics [list $name] -fixed]} {
		$w add radiobutton -label $name -command mmucl::font_changed \
			-variable mmucl::Mmucl(pref,font,family)
	    }
	}
    }
}

proc mmucl::ses_name {ses} {
    variable Mmucl

    return "$ses: $Mmucl(ses,$ses,host)"
}

proc mmucl::ses_cur_menu {w} {
    variable Mmucl

    $w delete 0 end
    set Mmucl(tk_cur) $Mmucl(cur)

    foreach ses $Mmucl(sessions) {
	$w add radiobutton -label [ses_name $ses] -value $ses \
		-command mmucl::ses_cur_menu_changed \
		-variable mmucl::Mmucl(tk_cur)
    }
}

proc mmucl::ses_cur_menu_changed {} {
    variable Mmucl

    MCsession $Mmucl(cur) switch $Mmucl(tk_cur)
}

proc mmucl::ses_snoop_menu {w} {
    variable Mmucl

    $w delete 0 end

    foreach ses $Mmucl(sessions) {
	$w add checkbutton -label [ses_name $ses] \
		-variable mmucl::Mmucl(ses,$ses,snoop)
    }
}

proc mmucl::choose_color {title which w entry {tag ""}} {
    variable Mmucl

    if {$tag ne ""} {
	set index pref,ansi,$tag
    } else {
	set index pref,$which
    }

    set res [tk_chooseColor -initialcolor $Mmucl($index) -title $title]

    if {$res ne ""} {
	set Mmucl($index) $res

	foreach ses $Mmucl(sessions) {
	    set disp .display$ses
	    
	    if {$tag ne ""} {
		$disp tag configure $tag -$which $res
	    } else {
		$disp configure -$which $res
	    }
	}

	$w entryconfigure $entry -background $res -activebackground $res
    }
}


proc mmucl::tk_session_close {} {
    variable Mmucl

    set ses $Mmucl(cur)

    if {$Mmucl(ses,$ses,connect)} {
	set s [tk_messageBox -type yesno \
           -message "Session $ses is still connected.\nReally close session?"]

	if {$s eq "no"} {
	    return
	}
    }

    if {[llength $Mmucl(sessions)] == 1} {
	MCexit $ses
    } else {
	MCsession $ses close $ses
    }
}

proc mmucl::update_view {w name} {
    variable Mmucl

    if {$Mmucl(pref,view,$name)} {
	if {$name eq "menubar"} {
	    . configure -menu $w
	} else {
	    grid $w
	}
    } else {
	if {$name eq "menubar"} {
	    . configure -menu ""
	} else {
	    grid remove $w
	}
    }
}

proc mmucl::tk_exit {} {
    variable Mmucl

    foreach ses $Mmucl(sessions) {
	if {$Mmucl(ses,$ses,connect)} {
	    set s [tk_messageBox -type yesno \
		    -message "Session $ses is still connected.\nReally quit?" \
		    -icon question]

	    if {$s eq "yes"} {
		MCexit $Mmucl(cur)
	    }

	    return
	}
    }

    MCexit $Mmucl(cur)
}

proc mmucl::session_added {} {
    variable Mmucl

    set ses $Mmucl(cur)
    
    set Mmucl(ses,$ses,user_status) ""
    set Mmucl(ses,$ses,connect_duration) ""

    text .display$ses -state disabled -yscrollcommand [list .vscroll$ses set] \
	    -font [list $Mmucl(pref,font,family) $Mmucl(pref,font,size)] \
	    -foreground $Mmucl(pref,foreground) \
	    -background $Mmucl(pref,background)
    scrollbar .vscroll$ses -orient vertical -command [list .display$ses yview]

    set w .display$ses

    bind .input <Next> {.display$mmucl::Mmucl(cur) yview scroll 1 page; break}
    bind .input <Prior> \
	    {.display$mmucl::Mmucl(cur) yview scroll -1 page; break}
    bind .input <Home>  {.display$mmucl::Mmucl(cur) see 1.0}
    bind .input <Key>  {+.display$mmucl::Mmucl(cur) see end}

    # bold font
    $w tag configure 1 \
	    -font [list $Mmucl(pref,font,family) $Mmucl(pref,font,size) bold]
    
    # underline
    $w tag configure 4  -underline 1
    
    # should blink
    $w tag configure 5 -underline 1
    
    # FIXME: should reverse fg and bg
    $w tag configure 7 -background [$w cget -foreground] \
	    -foreground [$w cget -background]
    
    foreach tag {30 31 32 33 34 35 36 37} {
	$w tag configure $tag -foreground $Mmucl(pref,ansi,$tag)
    }

    foreach tag {40 41 42 43 44 45 46 47} {
	$w tag configure $tag -background $Mmucl(pref,ansi,$tag)
    }
    
    # needed to make selection visible.
    $w tag raise sel    

    pack [button .ses.$ses -text [ses_name $ses] \
	    -command "mmucl::MCsession \$mmucl::Mmucl(cur) switch $ses"] \
	-side left

    if {[llength $Mmucl(sessions)] > 1} {
	grid .ses
    }

    session_status $ses disconnected

    grid .display$ses -row 2 -column 0 -sticky news
    grid .vscroll$ses -row 2 -column 1 -sticky ns
}

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

    array set Mmucl {
	ansi_tags {{} 37 40}
	rxp,ansi_parse {^\[([0-9;]*)m(.*)$}
	hist_cur        ""
	pref,font,family Courier
	pref,font,size   12
	pref,ansi,30 slategrey   
	pref,ansi,31 red3        
	pref,ansi,32 green3      
	pref,ansi,33 yellow3     	
	pref,ansi,34 blue2           
	pref,ansi,35 magenta3 
	pref,ansi,36 cyan3
	pref,ansi,37 lightgrey
	pref,ansi,40 black
	pref,ansi,41 red3     
	pref,ansi,42 green3   
	pref,ansi,43 yellow3  
	pref,ansi,44 blue2    
	pref,ansi,45 magenta3 
	pref,ansi,46 cyan3    
	pref,ansi,47 lightgrey
	pref,background black
	pref,foreground lightgrey
	pref,view,toolbar   1      
	pref,view,menubar   1      
	pref,view,statusbar 1
    }
    
    set rc [file join $config(rc_dir) .pref.$config(interface)]
    if {[file exists $rc] && [catch {source $rc} err]} {
	puts stderr "BUG: loading $rc: $err"
    }
    
    # It's pathetic that this isn't supported!

    if {[catch {package require Tk 8.4}]} {
	# try both libtk8.4 and libtk84
	
	if {[lsearch -exact [package names] Tk] == -1} {
	    set version [info tclversion]
	    set libs [glob -nocomplain \
			  [file join [file dirname [info library]] \
			       libtk${version}[info sharedlibextension]*]]
	    
	    if {[llength $libs]} {
		load [lindex $libs 0] Tk
	    } else {
		regsub -- {\.} $version "" version
		
		set libs [glob -nocomplain \
			      [file join [file dirname [info library]] \
				   libtk${version}[info sharedlibextension]*]]
		
		if {[llength $libs]} {
		    load [lindex $libs 0] Tk
		} else {
		    error "Cannot find Tk shared lib."
		}
	    }
	}
    
    }

    option add *Menu*tearOff 0

    foreach img [glob [file join $config(lib_dir) images *.*]] {
	image create photo img_[file rootname [file tail $img]] -file $img
    }
    
    if {$tcl_platform(platform) eq "unix"} {
	toplevel .icon
	label .icon.l -image img_mmucl -bd 0
	pack .icon.l
	wm iconwindow . .icon
    }

    wm title . Mmucl
    wm protocol . WM_DELETE_WINDOW {mmucl::MCexit $mmucl::Mmucl(cur)}

    bind Entry <Control-u> {%W delete 0 insert}
    bind Text <Control-u> {%W delete "insert linestart" insert}
    
    set ses $Mmucl(cur)
    set w [menu .menubar]

    $w add cascade -label Mmucl -menu $w.mmucl -underline 0
    $w add cascade -label Edit -menu $w.edit -underline 0
    $w add cascade -label View -menu $w.view -underline 0
    $w add cascade -label Session -menu $w.ses -underline 0
    $w add cascade -label Settings -menu $w.set -underline 2
    $w add cascade -label Options -menu $w.options -underline 0
    $w add cascade -label Help -menu $w.help -underline 0
    
    set w [menu .menubar.mmucl]
    
    $w add command -label Connect -underline 0 -command mmucl::tk_connect
    $w add separator
    $w add command -label Load -underline 0 -command mmucl::tk_source
    $w add command -label Send -underline 0 -command mmucl::tk_textin
    $w add command -label Save -underline 1 -command mmucl::tk_dump
    $w add separator
    $w add command -label Quit -accelerator Ctrl+Q -underline 0 \
	    -command mmucl::tk_exit

    bind . <Control-q> {mmucl::tk_exit}

    set w [menu .menubar.edit]
    
    $w add command -label Copy -underline 0\
	    -command {event generate .display$mmucl::Mmucl(cur) <<Copy>>}
    $w add command -label Paste -underline 0\
	    -command {event generate .input <<Paste>>}
    $w add separator
    $w add command -label Actions -underline 0 \
	    -command {mmucl::tk_edit action}
    $w add command -label Aliases -underline 1 \
	    -command {mmucl::tk_edit alias}
    $w add command -label Chars -underline 0 \
	    -command {mmucl::tk_edit char}
    $w add command -label Keys -underline 0 \
	    -command {mmucl::tk_edit key}
    $w add command -label Subs -underline 0 \
	    -command {mmucl::tk_edit sub}

    set w [menu .menubar.view]
    $w add checkbutton -label Menubar -underline 0 \
	    -variable mmucl::Mmucl(pref,view,menubar) \
	    -command {mmucl::update_view .menubar menubar}
    $w add checkbutton -label Toolbar -underline 0 \
	    -variable mmucl::Mmucl(pref,view,toolbar) \
	    -command {mmucl::update_view .toolbar toolbar}
    $w add checkbutton -label Statubar -underline 0 \
	    -variable mmucl::Mmucl(pref,view,statusbar) \
	    -command {mmucl::update_view .status statusbar}

    set w [menu .menubar.ses]

    $w add command -label New -underline 0 -accelerator Ctrl+N \
	    -command {mmucl::tk_ses_new}
    #$w add cascade -label Current -underline 1 -menu $w.current
    $w add cascade -label Snoop -underline 0 -menu $w.snoop
    $w add command -label Close -underline 0 -accelerator Ctrl+W \
	    -command {mmucl::tk_ses_close}

    bind . <Control-n> {mmucl::MCsession $mmucl::Mmucl(cur) new}
    bind . <Control-w> [namespace code tk_session_close]
    
    #set w [menu  .menubar.ses.current]
    #bind $w <FocusIn> {mmucl::ses_cur_menu %W}

    set w [menu  .menubar.ses.snoop]
    bind $w <FocusIn> {mmucl::ses_snoop_menu %W}

    set w [menu .menubar.set]
    
    $w add cascade -label "Font family" -menu $w.font_fam -underline 0
    $w add cascade -label "Font size" -menu $w.font_size -underline 5
    $w add cascade -label "Foreground color" -menu $w.fg_color -underline 1
    $w add cascade -label "Background color" -menu $w.bg_color -underline 1
    $w add cascade -label Palette -menu $w.palette -underline 0

    set w [menu .menubar.set.font_fam]
    bind $w <FocusIn> {mmucl::font_family_menu %W}
 
    set w [menu .menubar.set.font_size]
    foreach size {8 10 11 12 14 16 18} {
	$w add radiobutton -label $size -command mmucl::font_changed \
		-variable mmucl::Mmucl(pref,font,size)
    }

    set w [menu .menubar.set.fg_color]
    $w add command -background $Mmucl(pref,foreground) \
	    -activebackground $Mmucl(pref,foreground) \
	    -command [list mmucl::choose_color "Mmucl - Choose foreground" \
	    foreground $w 0]

    set w [menu .menubar.set.bg_color]
    $w add command -background $Mmucl(pref,background) \
	    -activebackground $Mmucl(pref,background) \
	    -command [list mmucl::choose_color "Mmucl - Choose foreground" \
	    background $w 0]


    set w [menu .menubar.set.palette]
    set i 0
    foreach tag {30 31 32 33 34 35 36 37} {
	$w add command -background $Mmucl(pref,ansi,$tag) \
		-activebackground $Mmucl(pref,ansi,$tag) \
		-command [list mmucl::choose_color \
		"Mmucl - Choose palette color" foreground $w $i $tag]
	incr i
    }
    foreach tag {40 41 42 43 44 45 46 47} {
	set break [expr {$tag eq "40"}]
	$w add command -columnbreak $break \
		-background $Mmucl(pref,ansi,$tag) \
		-activebackground $Mmucl(pref,ansi,$tag) \
		-command [list mmucl::choose_color \
		"Mmucl - Choose palette color" background $w $i $tag]
	incr i
    }

    set w [menu .menubar.options]

    $w add checkbutton -label Reconnect -variable mmucl::Mmucl(cfg,reconnect)
    $w add checkbutton -label "Keep line" -variable mmucl::Mmucl(cfg,keep_line)
    $w add checkbutton -label Actions -variable mmucl::Mmucl(cfg,actions)
    $w add checkbutton -label "Action By Line" \
	    -variable mmucl::Mmucl(cfg,action_by_line)
    $w add checkbutton -label Subs -variable mmucl::Mmucl(cfg,subs)
    $w add checkbutton -label "Strip ANSI" \
	    -variable mmucl::Mmucl(cfg,strip_ansi)
    $w add checkbutton -label "Local echo" -variable mmucl::Mmucl(cfg,echo)
    
    set w [menu .menubar.help]
    
    $w add command -label About \
	    -command {mmucl::MChelp $mmucl::Mmucl(cur) About}
    $w add command -label Tutorial \
	    -command {mmucl::MChelp $mmucl::Mmucl(cur) Tutorial}
    $w add command -label Commands \
	    -command {mmucl::MChelp $mmucl::Mmucl(cur) Procedures}
    $w add command -label Contents \
	    -command {mmucl::MChelp $mmucl::Mmucl(cur)}
    
    . configure -menu .menubar
    
    set w [menu .popup]
    $w add cascade -label "View" -menu $w.view -underline 0
    set w [menu $w.view]
    $w add checkbutton -label Menubar -underline 0 \
	    -variable mmucl::Mmucl(pref,view,menubar) \
	    -command {mmucl::update_view .menubar menubar}
    $w add checkbutton -label Toolbar -underline 0 \
	    -variable mmucl::Mmucl(pref,view,toolbar) \
	    -command {mmucl::update_view .toolbar toolbar}
    $w add checkbutton -label Statubar -underline 0 \
	    -variable mmucl::Mmucl(pref,view,statusbar) \
	    -command {mmucl::update_view .status statusbar}    

    bind . <Button-3> {tk_popup .popup %X %Y}

    set w [frame .toolbar]
    
    button $w.con -command mmucl::tk_connect -image img_connect 
    balloon_add $w.con "Connect to mud"
    button $w.load -image img_load -command {mmucl::tk_source}
    balloon_add $w.load "Load a file"
    button $w.send -image img_send -command {mmucl::tk_textin}
    balloon_add $w.send "Send a file"
    button $w.save -image img_save -command {mmucl::tk_dump}
    balloon_add $w.save "Save state"
    button $w.char -image img_char -command {mmucl::tk_edit char}
    balloon_add $w.char "Edit characters"
    button $w.alias -image img_alias -command {mmucl::tk_edit alias}
    balloon_add $w.alias "Edit aliases"
    button $w.action -image img_action -command {mmucl::tk_edit action}
    balloon_add $w.action "Edit actions"
    button $w.sub -image img_sub -command {mmucl::tk_edit sub}
    balloon_add $w.sub "Edit subs"
    button $w.key -image img_bind -command {mmucl::tk_edit key}
    balloon_add $w.key "Edit keys"

    pack $w.con $w.load $w.send $w.save $w.char $w.alias $w.action $w.sub \
	$w.key -side left 

    mmucl::user_entry .input

    .input configure \
	    -font [list $Mmucl(pref,font,family) $Mmucl(pref,font,size)] \
	    -background lightsteelblue

    label .status -anchor w
    frame .ses

    session_added

    grid .toolbar -row 0 -column 0  -sticky ew
    grid .ses -row 1 -column 0 -sticky news
    grid remove .ses
    grid .input -row 3 -column 0 -columnspan 2 -sticky news
    grid .status -row 4 -column 0 -columnspan 2 -sticky news
    grid columnconfigure . 0 -weight 1
    grid rowconfigure . 2 -weight 1
    
    focus .input

    update_view .menubar menubar
    update_view .toolbar toolbar
    update_view .status statusbar

    # FIXME
    wm command . $::argv

    rename interface_init ""
}