#!/bin/sh
# The next line restarts using wish \
#exec wish "$0" ${1+"$@"}

#---------------------------------------------------------------------------
# TkConv v3.0.1kcm2 Tcl/Tk converse chat client
#
# Macintosh Specific Portions Copyright (C) 2000 by Carl Makin VK1KCM <carl@stagecraft.cx>
#
# This Macintosh port based on the Unix version by;
#
# Copyright (C) 2000 by Tomi Manninen OH2BNS <tomi.manninen@hut.fi>
#
# Based on chat.tcl by Dave Brown N2RJT <dcb@vectorbd.com>
# and tkconv v1.0 by Carl Makin VK1KCM <carl@stagecraft.cx>
#
#    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.
#
#---------------------------------------------------------------------------
# File paths
#
set UserConfig  ".tkconvrc"
set ConversRc   ".conversrc"
set LogFileName "tkconv.log"
set HelpFile    "tkconvhelp.txt"
#
# Configuration defaults
#
set config(hostname)    ""
set config(port)        "3600"
set config(callsign)    ""
set config(channel)     ""
set config(nickname)    ""
set config(logging)     "off"
set config(autoconnect) "off"
set config(bell)        "off"
set config(font)        "monaco"
set config(rxwinsize)   "300"
set config(bgclr)       "black"
set config(alclr)       "#ed181e"
set config(txclr)       "#4192cc"
set config(rxclr)       "#d3d3d3"

set config(clr0)        "#00ff00"
set config(clr1)        "#aaaaff"
set config(clr2)        "#ff8888"
set config(clr3)        "#ffff00"
set config(clr4)        "#00ffff"
set config(clr5)        "#ffdead"
set config(clr6)        "#ff44aa"
set config(clr7)        "#bbbbbb"
#
# Other global stuff
#
set TkConvVer "v3.0.1kcm2"
set CurrentStatus "Not Connected"
set CallsignList ""
set ConnId ""
set ConnName ""
set LogFile ""
set LoginCommands ""
set LineCount 0
set thisfont "monaco 12"

console hide

#---------------------------------------------------------------------------
# Now the procedures...
#
proc currtime {} {
    return [clock format [clock seconds] -format "%d.%m.%Y %H:%M"]
}

proc SetupRxWin {} {
    global config

    .t configure -background $config(bgclr)

    .t tag configure RxAlarm -foreground $config(alclr) \
	    -background $config(bgclr) -wrap word
    .t tag configure RxDflt  -foreground $config(rxclr) \
	    -background $config(bgclr) -wrap word
    .t tag configure Sent    -foreground $config(txclr) \
	    -background $config(bgclr) -wrap word

    .t tag configure rxtag0 -foreground $config(clr0) \
	    -background $config(bgclr) -wrap word -lmargin2 60 
    .t tag configure rxtag1 -foreground $config(clr1) \
	    -background $config(bgclr) -wrap word -lmargin2 60
    .t tag configure rxtag2 -foreground $config(clr2) \
	    -background $config(bgclr) -wrap word -lmargin2 60
    .t tag configure rxtag3 -foreground $config(clr3) \
	    -background $config(bgclr) -wrap word -lmargin2 60
    .t tag configure rxtag4 -foreground $config(clr4) \
	    -background $config(bgclr) -wrap word -lmargin2 60
    .t tag configure rxtag5 -foreground $config(clr5) \
	    -background $config(bgclr) -wrap word -lmargin2 60
    .t tag configure rxtag6 -foreground $config(clr6) \
	    -background $config(bgclr) -wrap word -lmargin2 60
    .t tag configure rxtag7 -foreground $config(clr7) \
	    -background $config(bgclr) -wrap word -lmargin2 60

    # Make sure the selection tag has highest priority
    .t tag raise sel


}

proc ShowCallsignList {} {
    global CallsignList

    set callsigns [ join $CallsignList "\n " ]
    tk_messageBox -message "List of known callsigns:\n\n $callsigns" -type ok
}

proc ActionCmd {action} {
    global ConnId

    if {$ConnId == ""} {
	tk_messageBox -message "You need to be connected first!" -type ok
    } else {
	show Sent $action
	puts $ConnId $action
	flush $ConnId
    }
}

proc AboutPopup {} {
    global TkConvVer

    toplevel .p -class Dialog
    wm title .p "About TkConv"
    wm transient .p .

    frame .p.top -relief raised -bd 1
    frame .p.bot -relief raised -bd 1
    pack .p.top .p.bot -side top -fill both

    label .p.l1 -text "TkConv $TkConvVer" -font monaco
    label .p.l2 -text \
	"Macintosh Port by Carl Makin, VK1KCM\n<carl@stagecraft.cx>"
    label .p.l3 -text \
 "Ported from TkConv v3.0 by Tomi Manninen, OH2BNS\n<tomi.manninen@hut.fi>"
    label .p.l4 -text \
	"\nBased on tkconv v1.0 by Carl Makin, VK1KCM\nand\nchat.tcl by Dave Brown, N2RJT"
    pack .p.l1 .p.l2 .p.l3 .p.l4 -in .p.top -side top -padx 3m -pady 2m

    button .p.close -text "Close" -default normal -command {destroy .p}
    pack .p.close -in .p.bot -side top -padx 3m -pady 2m

    centerWindow .p
    grab .p
    focus .p.close
}

#proc tkAboutDialog {} {
 #   AboutPopup
#}
proc DoLogging {} {
    global config LogFile LogFileName

    if {$config(logging) == "on"} {
	set LogFile [open $LogFileName "a+"]
    } elseif {$LogFile != ""} {
	close $LogFile
	set LogFile ""
    }
}

proc show {tagname data} {
    global config LineCount

    update idletasks
    set position [lindex [.t yview] 1]
    .t configure -state normal
    if {$config(rxwinsize) == -1 || $LineCount <= $config(rxwinsize)} {
	incr LineCount
    } else {
	.t delete 1.0 2.0
    }
    .t insert end "$data\n" $tagname
    .t configure -state normal
    if {$position == 1} {
	.t see [.t index end]
    }
}

proc sendIt {} {
    global config sendData ConnId LogFile

    if {$ConnId != ""} {
        puts $ConnId "$sendData"
	flush $ConnId
	if {$config(logging) == "on"} {
		puts $LogFile "$sendData"
		flush $LogFile
	}
    }
    show Sent "$sendData"
    .t see [.t index end]
    set sendData ""
}

proc ShowRxLine {line} {
    global CallsignList config

    set idx -1
    set ptr [string first ">" $line]
    if {$ptr != -1} {
	#
	# Extract the callsign from "<oh2bns>" or "<*oh2bns*>"
	#
	if {[string range $line 1 1] == "*"} {
	    set call [string range $line 2 [expr $ptr - 2]]
	} else {
	    set call [string range $line 1 [expr $ptr - 1]]
	}
	#
	# See if there is a channel number or a nickname in the extracted
	# callsign. Possible formats are:
	#     "oh2bns"
	#     "oh2bns:tomi"
	#     "12345:oh2bns"
	#     "12345:oh2bns:tomi"
	#
	set ptr [string first ":" $call]
	if {$ptr != -1} {
	    set tmp [string range $call 0 [expr $ptr - 1]]
	    #
	    # If the first part is all digits, assume it's a channel number
	    #
	    if {[regexp {^[0-9]+$} $tmp] == 1} {
		set tmp [string range $call [expr $ptr + 1] end]
		set ptr [string first ":" $tmp]
		if {$ptr != -1} {
		    set tmp [string range $tmp 0 [expr $ptr - 1]]
		}
	    }
	    set call $tmp
	}
	#
	# Find it from the list of known callsigns or append if not found.
	#
	set idx [lsearch -exact $CallsignList $call]
	if {$idx == "-1"} {
	    lappend CallsignList $call
	    set idx [lsearch -exact $CallsignList $call]
	}
	set idx [expr $idx % 8]
    }
    #
    # see if there are any bell characters
    #
    if {$config(bell) == "on" && [regexp "\007" $line] == 1} {
	bell
    }

    switch $idx \
	    "0"       {show rxtag0 $line} \
	    "1"       {show rxtag1 $line} \
	    "2"       {show rxtag2 $line} \
	    "3"       {show rxtag3 $line} \
	    "4"       {show rxtag4 $line} \
	    "5"       {show rxtag5 $line} \
	    "6"       {show rxtag6 $line} \
	    "7"       {show rxtag7 $line} \
	    "default" {show rxclr $line};
}

proc readIt {} {
    global config ConnId LogFile

    if {$ConnId != ""} {
	if {[eof $ConnId] == 1} {
	    disconnect "EOF"
	    return
	}
	set ret [catch {gets $ConnId} line]
	if {$ret != 0} {
	    disconnect $line
	    return
	}
	if {$line != ""} {
	    switch -- [string range $line 0 0] \
		    "<"       {ShowRxLine   $line} \
		    "*"       {show RxAlarm $line} \
		    "default" {show RxDflt  $line};
	    if {$config(logging) == "on"} {
		puts $LogFile "$line"
		flush $LogFile
	    }
	}
    }
}

#---------------------------------------------------------------------------
# Configuration popups.
#
proc centerWindow {w} {
    wm withdraw $w
    update idletasks
    set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
	    - [winfo vrootx [winfo parent $w]]}]
    set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
	    - [winfo vrooty [winfo parent $w]]}]
    wm geom $w +$x+$y
    wm deiconify $w
}

proc serverPopup {} {
    global tmpconfig

    copy_fm_config

    toplevel .p -class Dialog
    wm title .p "Server Configuration"
    wm transient .p .

    frame .p.top -relief raised -bd 1
    frame .p.bot -relief raised -bd 1
    pack .p.top .p.bot -side top -fill both

    frame .p.left
    frame .p.right
    pack .p.left .p.right -in .p.top -side left
    entry .p.host -textvariable tmpconfig(hostname)
    entry .p.port -textvariable tmpconfig(port)
    entry .p.call -textvariable tmpconfig(callsign)
    entry .p.chan -textvariable tmpconfig(channel)
    entry .p.nick -textvariable tmpconfig(nickname)
    pack .p.host .p.port .p.call .p.chan .p.nick -in .p.right -side top
    label .p.hostl -anchor w -text "Hostname: "
    label .p.portl -anchor w -text "Port: "
    label .p.calll -anchor w -text "Callsign: "
    label .p.chanl -anchor w -text "Channel: "
    label .p.nickl -anchor w -text "Nickname: "
    pack .p.hostl .p.portl .p.calll .p.chanl .p.nickl \
	    -fill x -in .p.left -side top

    button .p.apply -text "Apply" -command {serverPopupApply}
    button .p.save  -text "Save"  -command {serverPopupSave}
    button .p.close -text "Close" -command {destroy .p}
    pack .p.apply .p.save .p.close -in .p.bot -side left \
	    -padx 2m -pady 3m

    .p.host selection range 0 end
    centerWindow .p
    grab .p
    focus .p.host
}

proc serverPopupApply {} {
    copy_to_config
}

proc serverPopupSave {} {
    serverPopupApply
    SaveConfig
}

proc loginPopup {} {
    global LoginCommands

    toplevel .p -class Dialog
    wm title .p "Login Script Configuration"
    wm transient .p .

    frame .p.top -relief raised -bd 1
    frame .p.bot -relief raised -bd 1
    pack .p.top .p.bot -side top -fill both

    frame .p.left
    frame .p.right
    pack .p.left .p.right -in .p.top -side left -fill y
    listbox .p.list
    pack .p.list -in .p.right -side top
    entry .p.entry -textvariable listentry
    button .p.ins -text "insert" -command {.p.list insert active $listentry}
    button .p.app -text "append" -command {.p.list insert end $listentry}
    button .p.del -text "delete" -command {.p.list delete active}
    pack .p.entry .p.ins .p.app .p.del -in .p.left -side top -fill x

    if {$LoginCommands != ""} {
	set len [llength $LoginCommands]
	for {set i 0} {$i < $len} {incr i} {
	    .p.list insert end [lindex $LoginCommands $i]
	}
    }

    button .p.apply -text "Apply" -command {loginPopupApply}
    button .p.save  -text "Save"  -command {loginPopupSave}
    button .p.close -text "Close" -command {destroy .p}
    pack .p.apply .p.save .p.close -in .p.bot -side left \
	    -padx 2m -pady 3m -expand yes

    centerWindow .p
    grab .p
    focus .p.entry
}

proc loginPopupApply {} {
    global LoginCommands
    set LoginCommands [.p.list get 0 end]
}

proc loginPopupSave {} {
    global LoginCommands ConversRc

    set LoginCommands [.p.list get 0 end]
    set file [open $ConversRc "w"]
    set len [llength $LoginCommands]
    for {set i 0} {$i < $len} {incr i} {
	puts $file [lindex $LoginCommands $i]
    }
    close $file
}

proc configPopup {} {
    global tmpconfig

    copy_fm_config

    toplevel .p -class Dialog
    wm title .p "Misc Configuration"
    wm transient .p .

    frame .p.top -relief raised -bd 1
    frame .p.mid1 -relief raised -bd 1
    frame .p.mid2 -relief raised -bd 1
    frame .p.bot -relief raised -bd 1
    pack .p.top .p.mid1 .p.mid2 .p.bot -side top -fill both

    checkbutton .p.log -text "Enable Logging" -anchor w \
	-onvalue "on" -offvalue "off" -variable tmpconfig(logging)
    checkbutton .p.auto -text "Enable Autoconnect" -anchor w \
	-onvalue "on" -offvalue "off" -variable tmpconfig(autoconnect)
    checkbutton .p.bell -text "Enable Bell" -anchor w \
	-onvalue "on" -offvalue "off" -variable tmpconfig(bell)
    pack .p.log .p.auto .p.bell -in .p.top \
	-side top -fill x

    frame .p.mid1.l
    frame .p.mid1.r
    pack .p.mid1.l .p.mid1.r -side left -fill both

    label .p.bufl -text "RX buffer length:   " -anchor nw
    pack .p.bufl -in .p.mid1.l -side top
    entry .p.buf -textvariable tmpconfig(rxwinsize) -width 10
    pack .p.buf -in .p.mid1.r -side top -fill x

    frame .p.mid2.l
    frame .p.mid2.r
    pack .p.mid2.l .p.mid2.r -side left -fill both

    label .p.font -text "Font size:          " -anchor nw
    pack .p.font -in .p.mid2.l -side top
    radiobutton .p.small -variable tmpconfig(font) -value "helvetica" \
	    -text "Helvetica" -anchor w
    radiobutton .p.norm  -variable tmpconfig(font) -value "monaco" \
	    -text "Monaco (Default)" -anchor w
    radiobutton .p.little -variable tmpconfig(size) -value "9" \
	    -text "Small (9 pt)" -anchor w
    radiobutton .p.large -variable tmpconfig(size) -value "12" \
	    -text "Default (12 pt)" -anchor w
    radiobutton .p.huge  -variable tmpconfig(size) -value "14" \
	    -text "Large (14 pt)" -anchor w
    pack .p.small .p.norm .p.little .p.large .p.huge -in .p.mid2.r \
	-side top -fill x

    button .p.apply -text "Apply" -command {configPopupApply}
    button .p.save  -text "Save"  -command {configPopupSave}
    button .p.close -text "Close" -command {destroy .p}
    pack .p.apply .p.save .p.close -in .p.bot -side left \
	    -padx 2m -pady 3m -expand yes

    centerWindow .p
    grab .p
    focus .p.close
}

proc configPopupApply {} {
    global config LineCount thisfont

    copy_to_config
    .t configure -state normal
    if {$config(rxwinsize) != -1} {
	while {$LineCount > $config(rxwinsize)} {
	    incr LineCount -1
	    .t delete 1.0 2.0
	}
    }
   set thisfont  "$config(font) $config(size)"
    .t configure -state normal
    .t configure -font $thisfont
    .t see [.t index end]
    .e configure -font $thisfont
    DoLogging
}

proc configPopupSave {} {
    configPopupApply
    SaveConfig
}

#---------------------------------------------------------------------------
# Connecting and disconnecting
#
proc connect {} {
    global config ConnId CurrentStatus TkConvVer LoginCommands ConnName

    if {$ConnId != ""} {
	tk_messageBox -message "You are already connected!" \
		-type ok
	return
    }
    if {$config(hostname) == ""} {
	tk_messageBox -message "You need to configure a server first!" \
		-type ok
	return
    }

    set ConnName $config(hostname):$config(port)
    set CurrentStatus "Connecting to $ConnName"
    update

    if {[catch {socket $config(hostname) $config(port)} ConnId] != 0} {
	set CurrentStatus "Not Connected"
	show RxAlarm "### Connection failed: $ConnId"
	set ConnId ""
	return
    }

    set CurrentStatus "Connected to $ConnName"

    fconfigure $ConnId -buffering full -buffersize 1024 -blocking false
    fileevent $ConnId readable {readIt}

    wm title . "TkConv $TkConvVer - $config(hostname)"
    show RxAlarm "### Connected to $ConnName ([currtime])"

    if {$config(callsign) != ""} {
	puts $ConnId "/n $config(callsign) $config(channel)"
	show Sent "/n $config(callsign) $config(channel)"
	if {$config(nickname) != ""} {
	    puts $ConnId "/nick $config(nickname)"
	    show Sent "/nick $config(nickname)"
	}
	puts $ConnId "/width 1000"
	show Sent "/width 1000"
	if {$LoginCommands != ""} {
	    set len [llength $LoginCommands]
	    for {set i 0} {$i < $len} {incr i} {
		puts $ConnId [lindex $LoginCommands $i]
		show Sent [lindex $LoginCommands $i]
	    }
	}
	flush $ConnId
    }
}

proc disconnect {reason} {
    global config CurrentStatus ConnId TkConvVer ConnName

    if {$ConnId != ""} {
	if {$reason == "normal"} {
	    puts $ConnId "/quit"
	    flush $ConnId
	}
	show RxAlarm "### Disconnected from $ConnName ([currtime]): $reason"
	close $ConnId
	set ConnId ""
    }
    set CurrentStatus "Not Connected"
    wm title . "TkConv $TkConvVer"
}

#---------------------------------------------------------------------------
# Color configuration stuff
#
proc GetColorDefaults {bg} {
    global tmpconfig

    if {$bg == "white"} {
	set tmpconfig(alclr) #ff0000
	set tmpconfig(rxclr) #a9a9a9
	set tmpconfig(txclr) #000000
	set tmpconfig(clr0)  #00aa00
	set tmpconfig(clr1)  #0000ff
	set tmpconfig(clr2)  #ff8800
	set tmpconfig(clr3)  #aaaa00
	set tmpconfig(clr4)  #008888
	set tmpconfig(clr5)  #ddaa88
	set tmpconfig(clr6)  #ff44aa
	set tmpconfig(clr7)  #777777
    } else {
 set config(alclr) "#ed181e"
 set config(txclr) "#4192cc"
 set config(rxclr) "#d3d3d3"
 set config(clr0) "#00ff00"
 set config(clr1) "#aaaaff"
 set config(clr2) "#ff8888"
 set config(clr3) "#ffff00"
 set config(clr4) "#00ffff"
 set config(clr5) "#ffdead"
 set config(clr6) "#ff44aa"
 set config(clr7) "#bbbbbb"

    }
}

proc chcolor {name} {
    global tmpconfig

    set init $tmpconfig($name)
    set color [tk_chooseColor -initialcolor $init -title "Choose Color"]
    if {$color == ""} {
	set color $init
    }
    set tmpconfig($name) $color
    .p.$name configure -fg $color
}

proc chbackground {} {
    global tmpconfig

    .p.alclr configure -bg $tmpconfig(bgclr)
    .p.rxclr configure -bg $tmpconfig(bgclr)
    .p.txclr configure -bg $tmpconfig(bgclr)
    .p.clr0  configure -bg $tmpconfig(bgclr)
    .p.clr1  configure -bg $tmpconfig(bgclr)
    .p.clr2  configure -bg $tmpconfig(bgclr)
    .p.clr3  configure -bg $tmpconfig(bgclr)
    .p.clr4  configure -bg $tmpconfig(bgclr)
    .p.clr5  configure -bg $tmpconfig(bgclr)
    .p.clr6  configure -bg $tmpconfig(bgclr)
    .p.clr7  configure -bg $tmpconfig(bgclr)
}

proc colorPopup {} {
    global config tmpconfig

    toplevel .p -class Dialog
    wm title .p "Color Configuration"
    wm transient .p .

    copy_fm_config

    frame .p.top -relief raised -bd 1
    frame .p.mid -relief raised -bd 1
    frame .p.mid2 -relief raised -bd 1
    frame .p.bot -relief raised -bd 1
    pack .p.top .p.mid .p.mid2 .p.bot -fill both -side top
    frame .p.left
    frame .p.right
    pack .p.left .p.right -in .p.mid2 -side left -expand yes

    label .p.bglabel -text "Background color: "
    radiobutton .p.black -variable tmpconfig(bgclr) -value "black" \
	    -text "black" -command {chbackground}
    radiobutton .p.white -variable tmpconfig(bgclr) -value "white" \
	    -text "white" -command {chbackground}
    pack .p.bglabel .p.black .p.white -in .p.top -side left \
	    -pady 5 -padx 5

    button .p.alclr -bg $tmpconfig(bgclr) -fg $tmpconfig(alclr) \
	    -text "alarm color" -command {chcolor alclr}
    button .p.rxclr -bg $tmpconfig(bgclr) -fg $tmpconfig(rxclr) \
	    -text "RX text color" -command {chcolor rxclr}
    button .p.txclr -bg $tmpconfig(bgclr) -fg $tmpconfig(txclr) \
	    -text "TX text color" -command {chcolor txclr}
    pack .p.alclr .p.rxclr .p.txclr -in .p.mid -side left \
	    -expand yes -pady 10 -padx 10

    button .p.clr0 -bg $tmpconfig(bgclr) -fg $tmpconfig(clr0) \
	    -text "received text color 0" -command {chcolor clr0}
    button .p.clr1 -bg $tmpconfig(bgclr) -fg $tmpconfig(clr1) \
	    -text "received text color 1" -command {chcolor clr1}
    button .p.clr2 -bg $tmpconfig(bgclr) -fg $tmpconfig(clr2) \
	    -text "received text color 2" -command {chcolor clr2}
    button .p.clr3 -bg $tmpconfig(bgclr) -fg $tmpconfig(clr3) \
	    -text "received text color 3" -command {chcolor clr3}
    pack .p.clr0 .p.clr1 .p.clr2 .p.clr3 -in .p.left -side top \
	    -pady 3 -padx 10

    button .p.clr4 -bg $tmpconfig(bgclr) -fg $tmpconfig(clr4) \
	    -text "received text color 4" -command {chcolor clr4}
    button .p.clr5 -bg $tmpconfig(bgclr) -fg $tmpconfig(clr5) \
	    -text "received text color 5" -command {chcolor clr5}
    button .p.clr6 -bg $tmpconfig(bgclr) -fg $tmpconfig(clr6) \
	    -text "received text color 6" -command {chcolor clr6}
    button .p.clr7 -bg $tmpconfig(bgclr) -fg $tmpconfig(clr7) \
	    -text "received text color 7" -command {chcolor clr7}
    pack .p.clr4 .p.clr5 .p.clr6 .p.clr7 -in .p.right -side top \
	    -pady 3 -padx 10

    button .p.defs  -text "Defaults" -command {colorPopupDefaults}
    button .p.apply -text "Apply"    -command {colorPopupApply}
    button .p.save  -text "Save"     -command {colorPopupSave}
    button .p.close -text "Close"    -command {destroy .p}
    pack .p.defs .p.apply .p.save .p.close -in .p.bot -side left \
	    -expand yes -pady 10 -padx 10

    centerWindow .p
    grab .p
    focus .p.close
}

proc colorPopupDefaults {} {
    global tmpconfig

    GetColorDefaults $tmpconfig(bgclr)
    .p.alclr configure -fg $tmpconfig(alclr) -bg $tmpconfig(bgclr)
    .p.rxclr configure -fg $tmpconfig(rxclr) -bg $tmpconfig(bgclr)
    .p.txclr configure -fg $tmpconfig(txclr) -bg $tmpconfig(bgclr)
    .p.clr0  configure -fg $tmpconfig(clr0)  -bg $tmpconfig(bgclr)
    .p.clr1  configure -fg $tmpconfig(clr1)  -bg $tmpconfig(bgclr)
    .p.clr2  configure -fg $tmpconfig(clr2)  -bg $tmpconfig(bgclr)
    .p.clr3  configure -fg $tmpconfig(clr3)  -bg $tmpconfig(bgclr)
    .p.clr4  configure -fg $tmpconfig(clr4)  -bg $tmpconfig(bgclr)
    .p.clr5  configure -fg $tmpconfig(clr5)  -bg $tmpconfig(bgclr)
    .p.clr6  configure -fg $tmpconfig(clr6)  -bg $tmpconfig(bgclr)
    .p.clr7  configure -fg $tmpconfig(clr7)  -bg $tmpconfig(bgclr)
}

proc colorPopupApply {} {
    copy_to_config
    SetupRxWin
}

proc colorPopupSave {} {
    colorPopupApply
    SaveConfig
}

#---------------------------------------------------------------------------
# Help display
#
proc HelpPopup {} {
    global HelpFile TkConvVer

    if {! [file exists $HelpFile]} {
	tk_messageBox -message "Can't open $HelpFile !" -type ok
	return
    }

    toplevel .h
    wm title .h "Help for TkConv $TkConvVer"

    frame .h.top -relief raised -bd 1
    text .h.top.text -yscrollcommand ".h.top.scroll set" -font monaco
    scrollbar .h.top.scroll -command ".h.top.text yview"
    pack .h.top.scroll -side right -fill y
    pack .h.top.text -side left -expand yes -fill both
    pack .h.top -side top -expand yes -fill both

    frame .h.bot -relief raised -bd 1
    button .h.bot.close -text "Close" -command {destroy .h}
    pack .h.bot.close -side top -padx 3m -pady 2m
    pack .h.bot -side top -fill both

    centerWindow .h

    .h.top.text delete 1.0 end
    set file [open $HelpFile]
    while {[eof $file] == 0} {
	.h.top.text insert end [read $file 1000]
    }
    close $file
    .h.top.text configure -state disabled
}

#---------------------------------------------------------------------------
# Configuration saving and restoring
#
proc SaveConfig {} {
    global config UserConfig TkConvVer

    set file [open $UserConfig "w"]
    puts $file "#"
    puts $file "# TkConv $TkConvVer configuration file."
    puts $file "# Machine generated, do not edit."
    puts $file "#"
    set id [array startsearch config]
    while {[set name [array nextelement config $id]] != ""} {
	    puts $file "set config($name) \"$config($name)\""
    }
    close $file
    array donesearch config $id
}

proc ReadConfig {} {
    global config UserConfig ConversRc LoginCommands

    if {[file exists $UserConfig]} {
	source $UserConfig
    }

    if {[file exists $ConversRc]} {
	set file [open $ConversRc "r"]
	while {[gets $file line] != -1} {
	    lappend LoginCommands $line
	}
	close $file
    }
}

proc copy_to_config {} {
    global config tmpconfig

    set id [array startsearch tmpconfig]
    while {[set name [array nextelement tmpconfig $id]] != ""} {
	set config($name) $tmpconfig($name)
    }
    array donesearch tmpconfig $id
}

proc copy_fm_config {} {
    global config tmpconfig

    set id [array startsearch config]
    while {[set name [array nextelement config $id]] != ""} {
	set tmpconfig($name) $config($name)
    }
    array donesearch config $id
}

wm protocol . WM_DELETE_WINDOW { 
   disconnect "Program Exit"
   exit
}

#---------------------------------------------------------------------------
# Ok let's start doing real work...
#
wm title . "tkconv $TkConvVer"
frame .sbar -relief groove -bd 3
pack .sbar -side top -fill x
label .status -textvariable CurrentStatus
pack .status -in .sbar -side right
scrollbar .ybar -orient vertical -command ".t yview"
pack .ybar -side right -fill y
#
# Receive window
#
text .t -relief sunken -borderwidth 2 -state normal  \
  -exportselection yes -yscrollcommand ".ybar set"
pack .t -expand yes -fill both
#
# Transmit window
#
entry .e -textvariable sendData -background lightgrey
pack .e -side bottom -fill x
bind .e <Return> {sendIt}
bind .e <Up> {.t yview scroll -1 units}
bind .e <Down> {.t yview scroll  1 units}
bind .e <Prior> {.t yview scroll -1 pages}
bind .e <Next> {.t yview scroll  1 pages}
focus .e

# bind Text <ButtonPress-1> {+focus %W}
#bind Text <ButtonRelease-1> {
#  event generate [focus] <<Copy>>
#	focus .e
#	}
bind Text <KeyPress> {
	focus .e
  .e insert end %A
}


#---------------------------------------------------------------------------
# Menus...
#
menu .mbar -tearoff 0
. configure -menu .mbar
.mbar add cascade -menu .mbar.file -label File
.mbar add cascade -menu .mbar.edit -label Edit
.mbar add cascade -menu .mbar.action -label Action
.mbar add cascade -menu .mbar.help -label Help
.mbar add cascade -menu .mbar.apple

menu .mbar.apple -tearoff no
.mbar.apple add command -label "About TkConv" -underline 0 -command {AboutPopu
p}


menu .mbar.edit
.mbar.edit add command -label Cut -accel Command-X -command {
   event generate [focus] <<Cut>>
}
.mbar.edit add command -label Copy -accel Command-C -command {
    event generate [focus] <<Copy>>
}
.mbar.edit add command -label Paste -accel Command-V -command {
   event generate [focus] <<Paste>>
}
.mbar.edit add command -label Clear -command {
    event generate [focus] <<Clear>>
}

# File menu
#
menu .mbar.file
.mbar.file add command -label "Connect" \
      -underline 0 -accel Command-N -command {connect}
.mbar.file add command -label "Disconnect" \
      -underline 0 -accel Command-D -command {disconnect "User Request"}
.mbar.file add separator
.mbar.file add cascade -label "Configure" -menu .mbar.file.config
menu .mbar.file.config -tearoff no
.mbar.file.config add command -label "Server..." \
      -underline 0 -command {serverPopup}
.mbar.file.config add command -label "Login..." \
      -underline 0 -command {loginPopup}
.mbar.file.config add command -label "Colors..." \
      -underline 0 -command {colorPopup}
.mbar.file.config add command -label "Misc..." \
      -underline 0 -command {configPopup}
.mbar.file add separator
.mbar.file add command -label "Known Callsigns..." \
     -underline 0 -accel Command-K -command {ShowCallsignList}
.mbar.file add separator
.mbar.file add command -label "Exit" \
     -underline 1 -accel Command-Q -command {disconnect "Program Exit"; exit}

#
# Action Menu
#
menu .mbar.action
.mbar.action add command -label "Who is on Channel (/who *)" \
      -underline 0 -accel Command-W -command {ActionCmd "/who *"}
.mbar.action add command -label "Display Channels (/who)" \
      -underline 8 -command {ActionCmd "/who"}
.mbar.action add command -label "Display Links (/links)" \
      -underline 8 -accel Command-L -command {ActionCmd "/links"}
.mbar.action add command -label "Display CStat (/cstat)" \
      -underline 9 -accel Command-S -command {ActionCmd "/cstat"}
#
# Help Menu
#
menu .mbar.help -tearoff no
.mbar.help add command -label "Help" -underline 0 -command {HelpPopup}

#---------------------------------------------------------------------------
# Read the config file and configure the stuff
#
ReadConfig
SetupRxWin
DoLogging
set thisfont "$config(font) $config(size)"
.t configure -font $thisfont
.e configure -font $thisfont
#
# For debugging the color code...
#
if {($argc == 1) && $argv == "debug"} {
    ShowRxLine "<test0> test"
    ShowRxLine "<test1> test"
    ShowRxLine "<test2> test"
    ShowRxLine "<test3> test"
    ShowRxLine "<test4> test"
    ShowRxLine "<test5> test"
    ShowRxLine "<test6> test"
    ShowRxLine "<test7> test"
    ShowRxLine "<oh2bns> test"
    ShowRxLine "<*oh2bns*> test"
    ShowRxLine "<12345:oh2bns> test"
    ShowRxLine "<12345:oh2bns:tomi> test"
    ShowRxLine "<oh2bns:tomi> test"
    ShowRxLine "<oh2bns> bell test \a"
}

#---------------------------------------------------------------------------
# ...and now, if autoconnect is set, connect
#
show RxAlarm "### Started on [currtime]"
if {$config(autoconnect) == "on"} {
    connect
}

#EOF