#! /bin/sh
# The next line is executed by /bin/sh, but not Tcl \
exec wish $0 ${1+"$@"}

# tik.tcl --
# A Tcl/Tk version of the Java TIC Applet.  This file contains all
# the ui and code that uses the toc.tcl file.
#
# Bugs: tictoc@aol.net   (please check FAQs on web page first)
# Home Page: http://www.aim.aol.com/tik
#
# $Revision: 1.180 $

# Copyright (c) 1998-9 America Online, Inc. All Rights Reserved.
#
#   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., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

# Set up the available tocs and auths.
set TOCS [list production]
set AUTHS [list production]
set TOC(production,host) toc.oscar.aol.com
set TOC(production,port) 9898 ;# Any port will work
set AUTH(production,host) login.oscar.aol.com
set AUTH(production,port) 1234 ;# Any port will work


set VERSION "TiK 0.75"
set REVISION {TIK:$Revision: 1.180 $}

# Make sure we are in the TiK directory and load the toc routines.
if {![string match "Windows*" $::tcl_platform(os)]} {
    cd [file dirname $argv0]
    catch {cd [file dirname [file readlink $argv0]]}
}
source toc.tcl
source sag.tcl

# Set our name for app default stuff
tk appname tik

# Remove the ability to send/receive X events.  If for some reason
# you want this call "tk appname tik" in your ~/tik/.tikrc
catch {rename send {}}

# Destroy all our children
eval destroy [winfo child .]
wm withdraw .

# Set the http user agent
catch {
    package require http 2.0
    http::config -useragent $VERSION
}

#######################################################
# PROTOCOL LISTENERS
#######################################################
# These are the TOC event listeners we registered.
# You can find the args documented in the PROTOCOL document.

proc SIGN_ON {name version} {
    # The following is true after migration
    if {[llength $::BUDDYLIST] > 0} {  
        tik_send_init 1
    }

    if {$::TIK(INFO,sendinfo)} {
        toc_set_info $name $::TIK(INFO,msg)
    }

    # We managed to sign on, now reconnecting is ok
    set ::TIK(reconnect) 1
}

proc CONFIG {name data} {

    set configFile $::TIK(configDir)/$::NSCREENNAME.config

    if {$::TIK(options,localconfig) == 3} {
        # Use the host config and backup locally, unless the
        # host config doesn't exist, then use the local config.

        if {[string length $data] < 5} {
            if {[file exists $configFile]} {
                puts "NOTICE: Host config was empty, using local config."
                set file [open $configFile "r"]
                set data [read $file]
                close $file
            }
        } else {
            set file [open $configFile "w"]
            puts -nonewline $file $data
            close $file
        }
    } elseif {$::TIK(options,localconfig) != 0} {
        # Ignore what we get from host if there is a local file
        if {[file exists $configFile]} {
            set data ""
            set f [open $configFile "r"]
            set data [read $f]
            close $f

            # Send local config to the host.
            if {$::TIK(options,localconfig) == 2} {
                if {[string length $data] > 2000} {
                    tk_messageBox -type ok -message [tik_str E_BIGCONFIG]
                } else {
                    toc_set_config $::NSCREENNAME $data
                }
            }
        }
    }

    tik_parse_config $data

    set ::TIK(IDLE,sent) 0
    tik_non_idle_event
    tik_check_idle
    tik_send_init 1

    set ::TIK(online) 1
    foreach package [lsort -ascii [array names ::TIK pkg,*,pkgname]] {
        set pkgname $::TIK($package)
        ${pkgname}::goOnline
    }

    tik_show_buddy
    tik_draw_list
}

proc NICK {name nick} {
    set ::SCREENNAME $nick

    tik_strs_buddy
}

proc IM_IN {name source msg auto} {
    tik_receive_im $source $auto $msg F
}

proc IM_OUT {name source msg auto} {
    tik_receive_im $source $auto $msg T
}

proc UPDATE_BUDDY {name user online evil signon idle uclass} {
    set bud [normalize $user]

    if {$user != $::BUDDIES($bud,name)} {
        foreach i $::BUDDIES($bud,indexs) {
            catch {sag::change_mainstring .buddy.list $i $user}
        }
    }

    if {$::TIK(options,showidletime)} {
        if {$idle == 0} {
            set ::BUDDIES($bud,otherString) ""
        } else {
            set ::BUDDIES($bud,otherString) [tik_str BL_IDLEDSP $idle]
        }

        if {$idle != $::BUDDIES($bud,idle)} {
            foreach i $::BUDDIES($bud,indexs) {
                catch {sag::change_otherstring .buddy.list $i \
                       $::BUDDIES($bud,otherString)}
            }
        }
    } else {
        set ::BUDDIES($bud,otherString) ""
    }

    set ::BUDDIES($bud,name) $user
    set o $::BUDDIES($bud,online)
    set ::BUDDIES($bud,online) $online
    set ::BUDDIES($bud,evil) $evil
    set ::BUDDIES($bud,signon) $signon
    set ::BUDDIES($bud,idle) $idle
    set u $::BUDDIES($bud,uclass)
    set ::BUDDIES($bud,uclass) $uclass

    tik_title_cim $user $o

    if {$o != $online} {
        if {$online == "T"} {
            set ::BUDDIES($bud,icon) Login
            tik_draw_list F
        } else {
            set ::BUDDIES($bud,icon) Logout
        }

        foreach i $::BUDDIES($bud,indexs) {
            catch {sag::change_icon .buddy.list $i $::BUDDIES($bud,icon)}
        }
        after $::TIK(options,removedelay) tik_removeicon $bud

        if {$bud != $::NSCREENNAME} {
            if {$online == "T"} {
                after 100 tik_play_sound2 $bud Arrive
            } else {
                after 100 tik_play_sound2 $bud Depart
            }
        }

        tik_update_group_cnts
    } elseif {$u != $uclass} {
        tik_update_uclass $bud
    }
    tik_update_ptext $bud
}

proc ERROR {name code data} {
    set args [split $data ":"]
    if {[catch {tk_messageBox -type ok -message [tik_str E_SRV_$code $args]}] != 0} {
        tk_messageBox -type ok -message [tik_str E_SRV_UNK $code $args]
    }
}

proc EVILED {name level user} {
    if {$::TIK(EVIL,level) < $level} {
        if {[string length $user] == 0 } {
            tk_messageBox -type ok -message [tik_str E_AWARN $level]
        } else {
            tk_messageBox -type ok -message [tik_str E_NWARN $level $user]
        }
    }
    set ::TIK(EVIL,level) $level
    tik_strs_buddy
}

proc CHAT_JOIN {name id loc} {
    catch {
        set people $::TIK(invites,$loc,people)
        set msg $::TIK(invites,$loc,msg)

        set p ""
        foreach i [split $people "\n" ] {
            set n [normalize $i]
            if {$n != "" } {
                append p $n
                append p " "
            }
        }

        if {$p != ""} {
            toc_chat_invite $name $id $msg $p
        }

        unset ::TIK(invites,$loc,people)
        unset ::TIK(invites,$loc,msg)
    }

    tik_create_chat $id $loc
}

proc CHAT_LEFT {name id} {
    tik_leave_chat $id
}

proc CHAT_IN {name id source whisper msg} {
    tik_receive_chat $id $source $whisper $msg
}

proc CHAT_UPDATE_BUDDY {name id online blist} {
    set w $::TIK(chats,$id,list)

    if {[winfo exists $w] == 0} {
        return
    }

    foreach p $blist {
        set np [normalize $p]
        if {[info exists ::TIK(chats,$id,people,$np)]} {
            if {$online == "F"} {
                catch {sag::remove $w $::TIK(chats,$id,people,$np)}
                tik_receive_chat $id "*" F [tik_str CHAT_DEPART $p]
                unset ::TIK(chats,$id,people,$np)
            }
        } else {
            if {$online == "T"} {
                set ::TIK(chats,$id,people,$np) [sag::add $w 0 "" $p ""\
                    $::TIK(options,buddymcolor) $::TIK(options,buddyocolor)]
                tik_receive_chat $id "*" F [tik_str CHAT_ARRIVE $p]
            }
        }
    }
}

proc CHAT_INVITE {name loc id sender msg} {
    tik_create_accept $loc $id $sender $msg
}

proc GOTO_URL {name window url} {
    set toc $::SELECTEDTOC

    if {[string match "http://*" $url]} {
        tik_show_url $window $url
    } else {
        if {$::USEPROXY != "None"} {
            ;# When using a proxy host must be an ip already.
            set ip $::TOC($toc,host)
        } else {
            ;# Not using socks, look up the peer ip.
            set ip [lindex [sflap::peerinfo $name] 0]
        }
        tik_show_url $window "http://$ip:$::TOC($toc,port)/$url"
    }
}

proc PAUSE {name data} {
    puts "PAUSING"
}

proc CONNECTION_CLOSED {name data} {
    tik_show_login
    setStatus [tik_str STAT_CLOSED]
    catch {after cancel $::TIK(IDLE,timer)}
    set ::TIK(IDLE,sent) 0
    set ::TIK(online) 0
    foreach package [lsort -ascii [array names ::TIK pkg,*,pkgname]] {
        set pkgname $::TIK($package)
        ${pkgname}::goOffline
    }

    # TIK(reconnect) is true if it is alright to reconnect
    # TIK(options,persistent) is true if the user wants us to reconnect.
    if {$::TIK(reconnect) && $::TIK(options,persistent)} {
        tik_signon
    }
}

#######################################################
# CALLBACKS
#######################################################
# This routines are callbacks for buttons and menu selections.

# tik_get_info --
#     Request information on a person
#
# Arguments:
#     name   - SFLAP connection
#     person - get info on

proc tik_get_info {name person} {
    if { $person == "" } {
        tk_messageBox -type ok -message [tik_str E_NEEDINFO]
    } else {
        toc_get_info $name $person
    }
}

# tik_signon --
#     Called when then Signon button is pressed.  This starts the
#     signon process.

proc tik_signon {} {
    if {$::TIK(online)} {
        puts "tik_signon called when already online!"
        return
    }

    # Don't try and reconnect when trying to signon
    set ::TIK(reconnect) 0

    if {[string length [normalize $::SCREENNAME]] < 2} {
        tk_messageBox -type ok -message [tik_str E_NEEDSN]
        return
    }

    if {[string length $::PASSWORD] < 3} {
        tk_messageBox -type ok -message [tik_str E_NEEDPASS]
        return
    }

    set ::BUDDYLIST [list]
    set ::PERMITLIST [list]
    set ::DENYLIST [list]
    catch {unset ::BUDDIES}
    catch {unset ::GROUPS}
    set ::PDMODE 1
    set ::NSCREENNAME [normalize $::SCREENNAME]

    setStatus [tik_str STAT_CONN]

    set auth $::SELECTEDAUTH
    set toc $::SELECTEDTOC

    toc_open $::NSCREENNAME $::TOC($toc,host) $::TOC($toc,port) \
        $::AUTH($auth,host) $::AUTH($auth,port) \
        $::NSCREENNAME $::PASSWORD english $::REVISION \
        $::TIK(proxies,$::USEPROXY,connFunc)
}

# tik_set_color --
#     Allow the user to chose a color for a entry.
# 
# Arguments:
#     type - tik window type
#     desc - color choser window title
#     id   - tik window id

proc tik_set_color { type desc id} {
    set color [tk_chooseColor -initialcolor $::TIK($type,$id,color) -title $desc]
    if {$color == ""} {
        return
    }
    set ::TIK($type,$id,color) $color
    $::TIK($type,$id,msgw) configure -foreground $color
}

# tik_set_default_color --
#     Set the default color for a particular window type
# 
# Arguments:
#     type - The window type.
proc tik_set_default_color { type } {
    set color [tk_chooseColor -initialcolor $::TIK(options,$type)\
               -title [tik_str MISC_DCLR_TITLE]]

    if {$color == ""} {
        return
    }
    set ::TIK(options,$type) $color
}

# tik_signoff --
#     Start the signoff process.

proc tik_signoff {} {
    toc_close $::NSCREENNAME
    tik_show_login
    setStatus [tik_str STAT_CBACK]
    catch {after cancel $::TIK(IDLE,timer)}
    set ::TIK(IDLE,sent) 0
    set ::TIK(online) 0
    set ::TIK(reconnect) 0
    foreach package [lsort -ascii [array names ::TIK pkg,*,pkgname]] {
        set pkgname $::TIK($package)
        ${pkgname}::goOffline
    }
}

# tik_add_buddy --
#     Add a new buddy/group pair to the internal list of buddies.
#     This does not send anything to the server.
#
# Arguments:
#     group - group the buddy is in
#     name  - name of the buddy

proc tik_add_buddy {group name} {
    if {![info exists ::BUDDIES($name,online)]} {
        set ::BUDDIES($name,type) AIM
        set ::BUDDIES($name,online) F
        set ::BUDDIES($name,icon) ""
        set ::BUDDIES($name,indexs) ""
        set ::BUDDIES($name,popupText) ""
        set ::BUDDIES($name,otherString) ""
        set ::BUDDIES($name,name) $name
        set ::BUDDIES($name,idle) 0
        set ::BUDDIES($name,uclass) ""
        toc_add_buddy $::NSCREENNAME $name
    }

    if {![info exists ::GROUPS($group,people)]} {
        set ::GROUPS($group,people) [list]
        set ::GROUPS($group,collapsed) F
        set ::GROUPS($group,type) AIM
        set ::GROUPS($group,online) 0
        set ::GROUPS($group,total) 0
        lappend ::BUDDYLIST $group
        lappend ::GROUPS($group,people) $name
        tik_edit_draw_list
    } else {
        lappend ::GROUPS($group,people) $name
        tik_edit_draw_list $group $name
    }
    tik_update_group_cnts

    tik_draw_list
}

# tik_add_pd --
#     Add a new permit/deny person.  This doesn't change
#     anything on the server.
#
# Arguments:
#     group - either permit or deny
#     name  - the person to permit/deny

proc tik_add_pd {group name} {
    if {$group == "Permit"} {
        lappend ::PERMITLIST $name
    } else {
        lappend ::DENYLIST $name
    }
    tik_pd_draw_list
}

# tik_set_config --
#     Create a string that represents the current buddylist and permit/deny
#     settings.  Based on options we send this config to the host and/or
#     the local disk.

proc tik_set_config {} {
    set str ""
    append str "m $::PDMODE\n"
    foreach p $::PERMITLIST {
        append str "p $p\n"
    }
    foreach d $::DENYLIST {
        append str "d $d\n"
    }
    foreach g $::BUDDYLIST {
        if {$::GROUPS($g,type) != "AIM"} {
            continue
        }
        append str "g $g\n"
        foreach b $::GROUPS($g,people) {
            append str "b $b\n"
        }
    }

    if {$::TIK(options,localconfig) > 0} {
        set file [open "$::TIK(configDir)/$::NSCREENNAME.config" "w"]
        puts -nonewline $file $str
        close $file
    } 
    
    if { $::TIK(options,localconfig) != 1} {
        if {[string length $str] > 2000} {
            tk_messageBox -type ok -message [tik_str E_BIGCONFIG]
        } else {
            toc_set_config $::NSCREENNAME $str
        }
    }
}

# tik_send_init --
#     Send the TOC server initialization sequence.  Basically
#     the buddy list, permit/deny mode, followed by toc_init_done.
#
# Arguments:
#     first - If not the first we don't do the toc_init_done,
#             and we also clear the permit/deny settings before sending.

proc tik_send_init {first} {
    foreach g $::BUDDYLIST {
        if {$::GROUPS($g,type) != "AIM"} {
            continue
        }
        foreach b $::GROUPS($g,people) {
            lappend buds $b
        }
    }

    if {[info exists buds] == 0} {
        tik_add_buddy Buddies [normalize $::SCREENNAME]
    } else {
        toc_add_buddy $::NSCREENNAME $buds
    }

    if {!$first} {
        # This will flash us, but who cares, I am lazy. :(
        toc_add_permit $::NSCREENNAME
        toc_add_deny $::NSCREENNAME
    }

    if {$::PDMODE == "3"} {
        toc_add_permit $::NSCREENNAME $::PERMITLIST
    } elseif {$::PDMODE == "4"} {
        toc_add_deny $::NSCREENNAME $::DENYLIST
    }

    if {$first} {
        toc_init_done $::SCREENNAME
        if {$::TIK(CAPS) != ""} {
            toc_set_caps $::SCREENNAME $::TIK(CAPS)
        }
    }
}

# tik_is_buddy --
#     Check to see if a name is on our buddy list.
#
# Arguments:
#     name - buddy to look for.

proc tik_is_buddy {name} {
    foreach g $::BUDDYLIST {
        foreach b $::GROUPS($g,people) {
            if {$b == $name} {
                return 1
            }
        }
    }

    return 0
}

# tik_show_url --
#     Routine that is called to display a url.  By default
#     on UNIX we just call netscape, on windows we use start.
#
# Arguments:
#     window - The window name to display the url in, ignored here
#     url    - The url to display.

if {[string match "Windows*" $::tcl_platform(os)]} {
    proc tik_show_url {window url} {
        catch {exec start $url &}
    }
} else {
    proc tik_show_url {window url} {
        catch {exec netscape -remote openURL($url) &}
    }
}

# tik_play_sound --
#     Play a sound file.   This is platform dependant, and will
#     need to be changed or overridden on some platforms.
#
# Arguments:
#     soundfile - The sound file to play.

set SOUNDPLAYING 0

# This keeps multiple sounds from building up.  Since
# au files are about 8000 bytes a sec we can guess how
# long the file is.
proc tik_play_sound {soundfile} {
    if {($soundfile == "none") || $::SOUNDPLAYING || 
        (![file exists $soundfile])} {
        return
    }

    set ::SOUNDPLAYING 1
    after [expr [file size $soundfile] / 8] set ::SOUNDPLAYING 0

    switch -glob -- $::tcl_platform(os) {
    "IRIX*" {
        catch {exec /usr/sbin/playaifc -p $soundfile 2> /dev/null &}
    }
    "OSF1*" {
        catch {exec /usr/bin/mme/decsound -play $soundfile 2> /dev/null &}
    }
    "HP*" {
        catch {exec /opt/audio/bin/send_sound $soundfile 2> /dev/null &}
    }
    "AIX*" {
        catch {exec /usr/lpp/UMS/bin/run_ums audio_play -f $soundfile 2> /dev/null &} 
    }
    "UnixWare*" -
    "SunOS*" {
        catch {exec dd if=$soundfile of=/dev/audio 2> /dev/null &}
    }
    "Windows*" {
        catch {exec C:/WINDOWS/rundll32.exe C:/WINDOWS/SYSTEM/amovie.ocx,RunDll /play /close $soundfile &}
    }
    default {
        catch {exec dd if=$soundfile of=/dev/audio 2> /dev/null &}
    }
    };# SWITCH
}

# tik_play_sound2 --
#     Wrapper for tik_play_sound that trys to find a unique sound
#     based on a normalized name first, before playing the default.
#
# Arguments:
#     norm      - The normalized name.
#     sound     - The sound to play.
proc tik_play_sound2 {norm sound} {
    if {[info exists ::TIK(SOUND,$norm,$sound)]} {
        tik_play_sound $::TIK(SOUND,$norm,$sound)
    } else {
        tik_play_sound $::TIK(SOUND,$sound)
    }
}

# tik_non_idle_event --
#     Called when an event happens that indicates we are not idle.
#     We check to see if we previous said we were idle, and change
#     that.

proc tik_non_idle_event {} {
    set ::TIK(IDLE,last_event) [clock seconds]
    if {$::TIK(IDLE,sent)} {
        set ::TIK(IDLE,sent) 0
        toc_set_idle $::NSCREENNAME 0
    }
}

# tik_check_idle --
#     Timer that checks to see if the last non idle event
#     happened more then 15 minutes ago.  If it did we tell the
#     server that we are idle.

proc tik_check_idle {} {
    set cur [clock seconds]

    if {$::TIK(options,idlewatchmouse)} {
        set XY [winfo pointerxy .]

        if {$XY != $::TIK(IDLE,XY)} {
            set ::TIK(IDLE,XY) $XY
            tik_non_idle_event
        }
    }

    if {!$::TIK(IDLE,sent)} {
        if {$cur - $::TIK(IDLE,last_event) > $::TIK(options,reportidleafter)} {
            # Only actually send up idle time to the server if the user wants.
            if {$::TIK(options,reportidle)} {
                toc_set_idle $::NSCREENNAME \
                    [expr ($cur - $::TIK(IDLE,last_event))]
            }
            set ::TIK(IDLE,sent) 1
        }
    }
    set ::TIK(IDLE,timer) [after 30000 tik_check_idle]
}

#######################################################
# UI UTILS
#######################################################
# createINPUT --
#     Create an input area based with different properities
#     based on set options.
#
# Arguments:
#     w  - the widget that will be packed in the upper layer, either
#          the widget created, or frame.
#     op - option to check.
#
# Returns:
#     The text or entry widget.

proc createINPUT {w op {width 40}} {
    if { $::TIK(options,$op) == 0} {
        entry $w -font $::NORMALFONT -width $width
        bind [winfo parent $w] <Control-u> "$w delete 0 end"
        return $w
    } elseif { $::TIK(options,$op) > 0 } {
        text $w -font $::NORMALFONT -width 40 \
            -height $::TIK(options,$op) -wrap word
        bind [winfo parent $w] <Control-u> "$w delete 0.0 end"
        return $w
    } else {
        frame $w
        text $w.text -font $::NORMALFONT -width 40 \
            -height [string range $::TIK(options,$op) 1 end] -wrap word \
            -yscrollcommand [list $w.textS set]
        scrollbar $w.textS -orient vertical -command [list $w.text yview]
        pack $w.textS -side right -in $w -fill y
        pack $w.text -side left -in $w -fill both -expand 1
        bind [winfo parent $w] <Control-u> "$w.text delete 0.0 end"
        return $w.text
    }
}

# createHTML --
#     Create a HTML display area, basically just a text area
#     and scrollbar.
#
# Arguments:
#     w - frame name to place everything in.
#
# Results:
#     The text widget.

proc createHTML {w} { 
    frame $w
    scrollbar $w.textS -orient vertical -command [list $w.text yview]
    text $w.text -font $::NORMALFONT -yscrollcommand [list $w.textS set] \
        -state disabled -width 40 -height 10 -wrap word
    pack $w.textS -side right -in $w -fill y
    pack $w.text -side left -in $w -fill both -expand 1

    $w.text tag configure italic -font $::ITALICFONT
    $w.text tag configure bold -font $::BOLDFONT
    $w.text tag configure underline -underline true
    $w.text tag configure bbold -foreground blue -font $::BOLDFONT
    $w.text tag configure rbold -foreground red -font $::BOLDFONT

    set ::HTML($w.text,linkcnt) 0
    set ::HTML($w.text,hrcnt) 0

    bind $w.text <Configure> "p_updateHRHTML $w.text %w"

    bind [winfo parent $w] <Key-Prior> "$w.text yview scroll -1 pages"
    bind [winfo parent $w] <Key-Next> "$w.text yview scroll 1 pages"

    return $w.text
}

# p_update_HRHTML --
#     Private method that takes care of resizing HR rule bars.
proc p_updateHRHTML {w width} {
   set width [expr {$width - 10}]

   for {set i 0} {$i < $::HTML($w,hrcnt)} {incr i} {
       $w.canv$i configure -width $width
   }
}

# addHTML --
#     Add HTML text to a text widget returned by createHTML.  We process
#     most simple HTML, and trash the hard stuff.
#
# Arguments:
#     w    - text area widget.
#     text - html to add to the text area.

proc addHTML {w text {doColor 0}} {
    set bbox [$w bbox "end-1c"]
    set bold 0
    set italic 0
    set underline 0
    set inlink 0
    set color "000000"
    set bgcolor "ffffff"

    set results [splitHTML $text]
    regsub -all "&lt;" $results "<" results
    regsub -all "&gt;" $results ">" results
    foreach e $results {
        switch -regexp -- $e {
            "^<[fF][oO][nN][tT].*>" {
                if {[regexp -nocase {back="#([0-9a-f]*)"} $e c]} {
                    set bgcolor [string range $c 7 [expr [string length $c]-2]]
                }

                if {[regexp -nocase {color="#([0-9a-f]*)"} $e c]} {
                    set color [string range $c 8 [expr [string length $c]-2]]
                }
            }
            "^</[fF][oO][nN][tT].*>" {
                set color "000000"
                set bgcolor "ffffff"
            }
            "^<[bB][oO][dD][yY][^#]*[bB][gG][cC][oO][lL][oO][rR]=\"?#\[0-9a-fA-F\].*>" {
                if {$doColor & 0x4} {
                    catch {set bgcolor [string range $e [expr \
                        [string first "#" $e]+1] [expr [string first "#" $e]+6]]
                    }
                    set bgcolor [string tolower $bgcolor]
                }
            }       
            "^<[bB]>$" {
                set bold 1
            }
            "^</[bB]>$" {
                set bold 0
            }
            "^<[iI]>$" {
                set italic 1
            }
            "^</[iI]>$" {
                set italic 0
            }
            "^<[uU]>$" {
                set underline 1
            }
            "^</[uU]>$" {
                set underline 0
            }
            "^<[aA].*>$" {
                set inlink 1
                incr ::HTML($w,linkcnt)
                $w tag configure link$::HTML($w,linkcnt) -font $::BOLDFONT \
                    -foreground blue -underline true
                $w tag bind link$::HTML($w,linkcnt) <Enter> {%W configure -cursor hand2}
                $w tag bind link$::HTML($w,linkcnt) <Leave> {
                    regexp {cursor=([^ ]*)} [%W tag names] x cursor
                    %W configure -cursor $cursor
                }
                if {[regexp {"(.*)"} $e match url]} {
                    $w tag bind link$::HTML($w,linkcnt) <ButtonPress> \
                               [list tik_show_url im_url $url]
                    $w tag bind link$::HTML($w,linkcnt) <ButtonPress-3> [list tik_showurl_popup $url %X %Y]
                    $w tag bind link$::HTML($w,linkcnt) <ButtonRelease-3> {tik_showurl_release}
                } else {
                    $w tag bind link$::HTML($w,linkcnt) <ButtonPress> \
                               [list tk_messageBox -type ok -message \
                               "Couldn't parse url from $e"]
                }
            }
            "^</[aA]>$" {
                set inlink 0
            }
            "^<[pP]>$" -
            "^<[pP] ALIGN.*>$" -
            "^<[bB][rR]>$" {
                $w insert end "\n"
            }
            "^<[hH][rR].*>$" {
                canvas $w.canv$::HTML($w,hrcnt) -width 1000 -height 3
                $w.canv$::HTML($w,hrcnt) create line 0 3 1000 3 -width 3
                $w window create end -window $w.canv$::HTML($w,hrcnt) -align center
                $w insert end "\n"
                incr ::HTML($w,hrcnt)
            }
            "^<[cC][eE][nN][tT][eE][rR].*>$" -
            "^<[hH][123456].*>$" -
            "^<[iI][mM][gG].*>$" -
            "^<[tT][iI][tT][lL][eE].*>$" -
            "^<[hH][tT][mM][lL].*>$" -
            "^<[bB][oO][dD][yY].*>$" -
            "^<[fF][oO][nN][tT].*>$" -
            "^<[pP][rR][eE]>$" -
            "^<!--.*-->$" -
            "^</.*>$" -
            "^$" {
            }
            default {
                set style [list]

                if {$bold} {
                    lappend style bold
                }
                if {$underline}  {
                    lappend style underline
                }
                if {$italic} {
                    lappend style italic
                }

                if {$inlink} {
                    set style [list link$::HTML($w,linkcnt)] ;# no style in links
                    lappend style cursor=[$w cget -cursor]
                }

                if {$doColor & 0x1} {
                    $w tag configure color$color -foreground #$color
                    lappend style color$color
                }

                if {($doColor & 0x6) && ($bgcolor != "ffffff")} {
                    $w tag configure bgcolor$bgcolor -background #$bgcolor
                    lappend style bgcolor$bgcolor
                }

                $w insert end $e $style
            }
        }
    }
    if {$bbox != ""} {
        $w see end
    }
}

# tik_lselect --
#     Used as the callback for dealing with the buddy list.
#     it allows you to set up two different commands to be called
#     based on if the item selected is a group or not.
#
# Arguements:
#     list     - list widget
#     command  - command if a normal buddy
#     gcommand - command if a group.  A "-" for gcommand means
#                call the $command argument with no args.

proc tik_lselect {list command {gcommand ""}} {
    set sel [sag::selection $list]

    set name $::NSCREENNAME

    if {$sel == ""} {
        if {$command != ""} {
            $command $name ""
        }
        return
    }

    foreach s $sel {
        set c [string index $s 0]
        if {$c == "+" || $c == "-"} {
            if {$gcommand == "-"} {
                $command $name ""
            } elseif {$gcommand != "" } {
                $gcommand $name [string range $s 2 end]
            }
        } else {
            if {$command != ""} {
                $command $name [string trim $s]
            }
        }
    }
}

# tik_handleGroup -
#     Double Click callback for groups.  This collapses the groups.
#
# Arguments:
#     name  - unused
#     group - the group to collapse

proc tik_handleGroup {name group} {
    if {$::GROUPS($group,collapsed) == "T"} {
        set ::GROUPS($group,collapsed) "F"
    } else {
        set ::GROUPS($group,collapsed) "T"
    }

    tik_draw_list
}


# tik_double_click --
#     The user double clicked on a buddy, call the registered double
#     click method for the buddy.
#
# Arguments:
#     name  - the SFLAP connection
#     buddy - the buddy that was double clicked.

proc tik_double_click {name buddy} {
    set nbud [normalize $buddy]
    if {[info exists ::BUDDIES($nbud,doubleClick)]} {
        $::BUDDIES($nbud,doubleClick) $name $buddy
    } else {
        tik_create_iim $name $buddy
    }
}

# tik_show_buddy --
#     Show the buddy window, we first withdraw
#     the login window in case it is around.

proc tik_show_buddy {} {
    if {[winfo exists .login]} {
        wm withdraw .login
    }

    if {[winfo exists .buddy]} {
        wm deiconify .buddy
        raise .buddy
    }
}

#######################################################
# Popup Routines
#######################################################

# tik_buddy_popup --
#     Generic routine for showing the popup for a buddy
#     at a given location.
#
# Arguments:
#     bud - The buddy to show information about, this might not
#           actually be a buddy in the true sense, since stocks can be.
#     X   - The x root position
#     Y   - The y root position

proc tik_buddy_popup {bud X Y} {
    set w .buddypopup
    catch {destroy $w}

    set nstr [normalize $bud]
    if {$nstr == ""} {
        return
    }
    toplevel $w -border 1 -relief solid
    wm overrideredirect .buddypopup 1

    set textlist $::BUDDIES($nstr,popupText)

    set nlen 0
    set vlen 0
    foreach {name value} $textlist {
        set nl [string length $name]
        set vl [string length $value]

        if {$nl > $nlen} {
            set nlen $nl
        }
        if {$vl > $vlen} {
            set vlen $vl
        }
    }

    set i 0
    foreach {name value} $textlist {
        label $w.name$i -text $name -width $nlen -anchor se
        label $w.value$i -text $value -width $vlen -anchor sw
        grid $w.name$i $w.value$i -in $w
        incr i
    }

    set width [expr ($vlen + $nlen) * 10]
    set height [expr ($i * 25)]
    set screenwidth [winfo screenwidth $w]
    set screenheight [winfo screenheight $w]

    incr Y 5
    incr X 5

    if {$X < 0} {
        set X 0
    } elseif {[expr $X + $width] > $screenwidth} {
        set X [expr $screenwidth - $width]
    }

#    if {[expr $Y + $height] > $screenheight} {
#        set Y [expr $screenheight - $height]
#    }

    wm geometry $w +$X+$Y
}

# tik_buddy_release --
#     Hide the buddy popup.
proc tik_buddy_release {} {
    catch {destroy .buddypopup}
}

# tik_showurl_popup --
#     Generic routine for showing a URL, which is just a string
#
# Arguments:
#     url - The url (or string) to show
#     X   - The x root position
#     Y   - The y root position

proc tik_showurl_popup {url X Y} {
    set w .urlpopup
    catch {destroy $w}

    if {$url == ""} {
        return
    }
    toplevel $w -border 1 -relief solid
    wm overrideredirect $w 1

    set nlen [string length $url]

    label $w.url -text $url
    pack $w.url

    set width $nlen
    set height 25
    set screenwidth [winfo screenwidth $w]
    set screenheight [winfo screenheight $w]

    if {$X < 0} {
        set X 0
    } elseif {[expr $X + $width] > $screenwidth} {
        set X [expr $screenwidth - $width]
    }

    if {[expr $Y + $height] > $screenheight} {
        set Y [expr $screenheight - $height]
    }

    wm geometry $w +$X+$Y
}

# tik_showurl_release --
#     Hide the url popup.
proc tik_showurl_release {} {
    catch {destroy .urlpopup}
}

#######################################################
# tik_create_buddy - 
#######################################################

proc tik_import_config {} {
    set fn [tk_getOpenFile -title [tik_str MISC_ICFG_TITLE]\
        -initialfile "$::NSCREENNAME.config"]

    if {$fn == ""} {
        return
    }

    set f [open $fn r]
    set data [read $f]
    close $f

    set len [llength $data]
    if {($len >= 2) && ([lindex $data 0] == "Version") && 
                       ([lindex $data 1] == "2")} {
        # This is a Java Config

        set config $data
        set data "m 1\n"
        puts "Trying to import a Java Config, this doesn't import Permit/Deny."
        for {set i 2} {$i < $len} {incr i} {
            if {[lindex $config $i] != "Buddy"} {
                continue;
            }

            # Found the Buddy Section
            incr i
            set config [lindex $config $i]
            set len [llength $config]
            for {set i 0} {$i < $len} {incr i} {
                if {[lindex $config $i] != "List"} {
                    continue;
                }

                # Found the Buddy List Section
                incr i
                set config [lindex $config $i]
                set len [llength $config]

                for {set i 0} {$i < $len} {incr i} {
                    append data "g [lindex $config $i]\n"
                    incr i
                    set buds [lindex $config $i]
                    set jlast [expr [llength $buds] - 1]
                    for {set j 0} {$j <= $jlast} {incr j} {
                       set bud [lindex $buds $j]
                       if {$j == $jlast} {
                           append data "b [normalize $bud]\n"
                       } else {
                           set budtmp [lindex $buds [expr {$j + 1}]]
                           if {[string first "\n" $budtmp] == -1} {
                               append data "b [normalize $bud]\n"
                           } else {
                               incr j
                           }
                       }
                    }
                }

                break;
            }
            break;
        }
    } elseif {($len >= 2) && ([lindex $data 0] == "Config") && 
                       ([string trim [lindex $data 1]] == "version 1")} {
        # This is a WIN 95 Config

        set config $data
        set data "m 1\n"
        puts "Trying to import a WIN95 Config, this doesn't import Permit/Deny."
        for {set i 2} {$i < $len} {incr i} {
            if {[string trim [lindex $config $i]] != "Buddy"} {
                continue;
            }

            # Found the Buddy Section
            incr i
            set config [lindex $config $i]
            set len [llength $config]
            for {set i 0} {$i < $len} {incr i} {
                if {[string trim [lindex $config $i]] != "list"} {
                    continue;
                }

                # Found the Buddy List Section
                incr i
                set config [lindex $config $i]
                set lines [split $config "\n\r"]
                foreach line $lines {
                    set line [string trim $line]
                    set len [llength $line]
                    if {$len == 0} continue
                    append data "g [lindex $line 0]\n"
                    for {set i 1} {$i < $len} {incr i} {
                        append data "b [lindex $line $i]\n"
                    }
                }
                break;
            }
            break;
        }
    }

    # Figure out current buddies and remove them
    foreach g $::BUDDYLIST {
        if {$::GROUPS($g,type) != "AIM"} {
            continue
        }
        foreach b $::GROUPS($g,people) {
            lappend buds $b
        }
    }
    toc_remove_buddy $::NSCREENNAME $buds

    # Parse the new config
    tik_parse_config $data
    tik_set_config
    tik_send_init 0
    tik_draw_list T
}

proc tik_export_config {} {
    set fn [tk_getSaveFile -title [tik_str MISC_ECFG_TITLE]\
        -initialfile "$::NSCREENNAME.config"]

    if {$fn != ""} {
        set f [open $fn w]
        puts -nonewline $f $::TIK(config)
        close $f
    }
}

# p_tik_buddy_press --
#     Private routine called when a mouse button is clicked on the buddy
#     list
proc p_tik_buddy_press {y X Y} {
    set str [sag::pos_2_mainstring .buddy.list [sag::nearest .buddy.list $y]]
    set f [string index $str 0]
    if {($f == "+") || ($f == "-")} {
        return
    }

    tik_buddy_popup $str $X $Y
}

proc tik_create_menubar {} {

    menu .menubar -type menubar
    bind .menubar <Motion> tik_non_idle_event
    destroy .fileMenu
    menu .fileMenu -tearoff 0
    .menubar add cascade -label [tik_str M_FILE] -menu .fileMenu -underline 0
    .fileMenu add command -label [tik_str M_FILE_AB] -command tik_create_add \
                          -accelerator Control+a
    .fileMenu add command -label [tik_str M_FILE_EB] -command tik_create_edit \
                          -accelerator Control+e
    .fileMenu add command -label [tik_str M_FILE_PD] -command tik_create_pd \
                          -accelerator Control+p
    .fileMenu add separator
    .fileMenu add command -label [tik_str M_FILE_EBL] -command tik_export_config
    .fileMenu add command -label [tik_str M_FILE_IBL] -command tik_import_config
    .fileMenu add separator
    .fileMenu add command -label [tik_str M_FILE_SO] -command tik_signoff
    .fileMenu add command -label [tik_str M_FILE_Q] -command {tik_signoff;exit}

    destroy .toolsMenu
    menu .toolsMenu -tearoff 0
    .menubar add cascade -label [tik_str M_TOOLS] -menu .toolsMenu -underline 0

    .toolsMenu add command -label [tik_str M_TOOLS_CI] -command tik_create_setinfo

    destroy .reloadMenu
    menu .reloadMenu -tearoff 0
    .toolsMenu add cascade -label [tik_str M_RELOAD] -menu .reloadMenu
    .reloadMenu add command -label [tik_str M_RELOAD_OPT] -command "source $::TIK(rcfile)"
    .reloadMenu add command -label [tik_str M_RELOAD_PKG] -command "tik_check_pkg"
    .reloadMenu add command -label [tik_str M_RELOAD_SAG] -command "source sag.tcl"

    destroy .generalMenu
    menu .generalMenu -tearoff 0
    .toolsMenu add cascade -label [tik_str M_GEN] -menu .generalMenu
    .generalMenu add command -label [tik_str M_WARN] -state disabled
    .generalMenu add separator
    .generalMenu add checkbutton -label [tik_str M_GEN_SND] -onvalue 0 -offvalue 1 \
                                -variable ::SOUNDPLAYING
    .generalMenu add checkbutton -label [tik_str M_GEN_PC] -onvalue 1 -offvalue 0 \
                                -variable ::TIK(options,persistent)
    .generalMenu add checkbutton -label [tik_str M_GEN_MRC] -onvalue 1 \
                                -offvalue 0 -variable ::TIK(options,monitorrc)
    .generalMenu add checkbutton -label [tik_str M_GEN_MPKG] -onvalue 1 \
                                -offvalue 0 -variable ::TIK(options,monitorpkg)
    .generalMenu add checkbutton -label [tik_str M_GEN_IDLE] -onvalue 1 \
                                -offvalue 0 -variable ::TIK(options,reportidle)

    destroy .msgSendMenu
    menu .msgSendMenu -tearoff 0
    .generalMenu add cascade -label [tik_str M_MSGSND] -menu .msgSendMenu
    .msgSendMenu add radiobutton -label [tik_str M_MSGSND_0] \
         -variable ::TIK(options,msgsend) -value 0
    .msgSendMenu add radiobutton -label [tik_str M_MSGSND_1] \
         -variable ::TIK(options,msgsend) -value 1
    .msgSendMenu add radiobutton -label [tik_str M_MSGSND_2] \
         -variable ::TIK(options,msgsend) -value 2
    .msgSendMenu add radiobutton -label [tik_str M_MSGSND_3] \
         -variable ::TIK(options,msgsend) -value 3

    destroy .localconfigMenu
    menu .localconfigMenu -tearoff 0
    .generalMenu add cascade -label [tik_str M_LCFG] -menu .localconfigMenu
    .localconfigMenu add radiobutton -label [tik_str M_LCFG_0] \
         -variable ::TIK(options,localconfig) -value 0
    .localconfigMenu add radiobutton -label [tik_str M_LCFG_1] \
         -variable ::TIK(options,localconfig) -value 1
    .localconfigMenu add radiobutton -label [tik_str M_LCFG_2] \
         -variable ::TIK(options,localconfig) -value 2
    .localconfigMenu add radiobutton -label [tik_str M_LCFG_3] \
         -variable ::TIK(options,localconfig) -value 3

    destroy .sflapMenu
    menu .sflapMenu -tearoff 0
    .generalMenu add cascade -label [tik_str M_SFLAP] -menu .sflapMenu
    .sflapMenu add radiobutton -label [tik_str M_SFLAP_0] \
         -variable sflap::debug_level -value 0
    .sflapMenu add radiobutton -label [tik_str M_SFLAP_1] \
         -variable sflap::debug_level -value 1
    .sflapMenu add radiobutton -label [tik_str M_SFLAP_2] \
         -variable sflap::debug_level -value 2

    destroy .languageMenu
    menu .languageMenu -tearoff 0 -postcommand tik_strs_menu
    .generalMenu add cascade -label [tik_str M_LANG] -menu .languageMenu

    destroy .displayMenu
    menu .displayMenu -tearoff 0
    .toolsMenu add cascade -label [tik_str M_DPY] -menu .displayMenu
    .displayMenu add command -label [tik_str M_WARN] -state disabled
    .displayMenu add separator
    .displayMenu add checkbutton -label [tik_str M_DPY_CT] -onvalue 1 -offvalue 0 \
                                -variable ::TIK(options,chattime)
    .displayMenu add checkbutton -label [tik_str M_DPY_IT] -onvalue 1 -offvalue 0 \
                                -variable ::TIK(options,imtime)
    .displayMenu add checkbutton -label [tik_str M_DPY_IR] -onvalue 1 \
                                -offvalue 0 -variable ::TIK(options,raiseim)
    .displayMenu add checkbutton -label [tik_str M_DPY_ID] -onvalue 1 \
                                -offvalue 0 -variable ::TIK(options,deiconifyim)
    .displayMenu add checkbutton -label [tik_str M_DPY_CR] -onvalue 1 \
                                -offvalue 0 -variable ::TIK(options,raisechat)
    .displayMenu add checkbutton -label [tik_str M_DPY_CD] -onvalue 1 \
                                -offvalue 0 -variable ::TIK(options,deiconifychat)
    .displayMenu add checkbutton -label [tik_str M_DPY_IF] -onvalue 1 \
                                -offvalue 0 -variable ::TIK(options,flashim)
    .displayMenu add checkbutton -label [tik_str M_DPY_GRP] -onvalue 1 \
                                -offvalue 0 -variable \
                                ::TIK(options,showgrouptotals) \
                                -command "tik_draw_list T"
    .displayMenu add checkbutton -label [tik_str M_DPY_ICON] -onvalue 1 \
                                -offvalue 0 -variable \
                                ::TIK(options,showicons) \
                                -command "tik_draw_list T"

    destroy .colorMenu
    menu .colorMenu -tearoff 0
    .toolsMenu add cascade -label [tik_str M_COLOR] -menu .colorMenu
    .colorMenu add command -label [tik_str M_WARN] -state disabled
    .colorMenu add separator
    .colorMenu add checkbutton -label [tik_str M_COLOR_EI] -onvalue 1 \
        -offvalue 0 -variable ::TIK(options,imcolor)
    .colorMenu add command -label [tik_str M_COLOR_CDI] \
        -command "tik_set_default_color defaultimcolor"
    .colorMenu add checkbutton -label [tik_str M_COLOR_EC] -onvalue 1 \
        -offvalue 0 -variable ::TIK(options,chatcolor)
    .colorMenu add command -label [tik_str M_COLOR_CDC] \
        -command "tik_set_default_color defaultchatcolor"
    .toolsMenu add separator

    destroy .menubar.help
    menu .menubar.help -tearoff 0
    .menubar add cascade -label [tik_str M_HELP] -menu .menubar.help \
        -underline 0
    .menubar.help add command -label [tik_str M_HELP_ABOUT] \
        -command tik_show_version
    .menubar.help add command -label [tik_str M_HELP_TIK] -command \
        "tik_show_url homepage http://www.aim.aol.com/tik"
    .menubar.help add command -label [tik_str M_HELP_TCL] -command \
        "tik_show_url homepage http://www.scriptics.com"
    
     
}

proc tik_strs_buddy {} {
    wm title .buddy [tik_str BL_TITLE]
    wm iconname .buddy [tik_str BL_ICON]
    .buddy.im configure -text [tik_str B_IM]
    .buddy.info configure -text [tik_str B_INFO]
    .buddy.chat configure -text [tik_str B_CHAT]
}

proc tik_buddy_enter {x y X Y} {
    set ::TIK(BUDDY,last) ""
    set ::TIK(BUDDY,fast) 0
}

proc tik_buddy_leave {x y X Y} {
    catch {after cancel $::TIK(BUDDY,job)}
    set ::TIK(BUDDY,fast) 0
    tik_buddy_release
}

proc p_tik_buddy_delayed {x y X Y} {
    set ::TIK(BUDDY,fast) 1
    p_tik_buddy_press $y $X $Y
}

proc tik_buddy_motion {x y X Y} {
    set str [sag::pos_2_mainstring .buddy.list [sag::nearest .buddy.list $y]]
    if {$::TIK(BUDDY,last) == $str} {
        return
    } else {
        tik_buddy_release
        catch {after cancel $::TIK(BUDDY,job)}
        set ::TIK(BUDDY,last) $str
        if {$::TIK(BUDDY,fast)} {
            p_tik_buddy_press $y $X $Y
        } else {
            set ::TIK(BUDDY,job) [after 1000 p_tik_buddy_delayed $x $y $X $Y]
        }
    }
}

proc tik_create_buddy {} {
    if {[winfo exists .buddy]} {
        destroy .buddy
    }

    # Load the images required
    image create photo Login -file media/Login.gif
    image create photo Logout -file media/Logout.gif
    image create photo Admin -file media/Admin.gif
    image create photo AOL -file media/AOL.gif
    image create photo Away -file media/Away.gif
    image create photo Oscar -file media/Oscar.gif
    image create photo DT -file media/DT.gif
    image create photo uparrow -file media/uparrow.gif
    image create photo downarrow -file media/downarrow.gif

    tik_create_menubar

    tik_register_buddy_button_func "AIM" "Send IM" tik_create_iim
    tik_register_buddy_button_func "AIM" "Get Info" toc_get_info

    # Create the Buddy Window
    toplevel .buddy -menu .menubar -class Tik
    if {$::TIK(options,windowgroup)} {wm group .buddy .login}

    bind .buddy <Control-a> tik_create_add
    bind .buddy <Control-e> tik_create_edit
    bind .buddy <Control-p> tik_create_pd
    bind .buddy <Motion> tik_non_idle_event

    wm withdraw .buddy

    set canvas [sag::init .buddy.list 200 300 1 $::SAGFONT #a9a9a9 \
        $::TIK(options,sagborderwidth)]

    bind $canvas <Double-Button-1> \
         {tik_lselect .buddy.list tik_double_click tik_handleGroup}
    bind $canvas <ButtonPress-3> {tik_buddy_button3_press %y %X %Y}

    frame .buddy.bottomF
    button .buddy.im -command {tik_lselect .buddy.list tik_double_click "-"}
    bind .buddy <Control-i> {tik_lselect .buddy.list tik_double_click "-"}
    button .buddy.info -command {tik_lselect .buddy.list tik_get_info}
    bind .buddy <Control-l> {tik_lselect .buddy.list tik_get_info }
    button .buddy.chat -command {tik_create_invite}
    bind .buddy <Control-c> tik_create_invite

    tik_strs_buddy

    bind $canvas <Enter>  {tik_buddy_enter %x %y %X %Y}
    bind $canvas <Leave>  {tik_buddy_leave %x %y %X %Y}
    bind $canvas <Motion> {tik_buddy_motion %x %y %X %Y}

    if {$::TIK(options,padframe)} {
        pack .buddy.im .buddy.info .buddy.chat -in .buddy.bottomF \
             -side left -padx 2m -pady 2m
    } else {
        pack .buddy.im .buddy.info .buddy.chat -in .buddy.bottomF \
             -side left
    }
        

    pack .buddy.bottomF -side bottom
    if {$::TIK(options,padframe)} {
        pack .buddy.list -fill both -expand 1 -padx 2m -side top
    } else {
        pack .buddy.list -fill both -expand 1 -side top
    }

    wm protocol .buddy WM_DELETE_WINDOW {destroy .}
}

#******************************************************
#********************BUDDY LIST METHODS ***************
#******************************************************

proc tik_parse_config {data} {
    set ::BUDDYLIST [list]
    set ::PERMITLIST [list]
    set ::DENYLIST [list]
    set ::PDMODE 1

    set ::TIK(config) $data
    set lines [split $data "\n"]
    foreach i $lines {
        switch -exact -- [string index $i 0] {
        "b" {
            set bud [normalize [string range $i 2 end]]
            set ::BUDDIES($bud,type) AIM
            set ::BUDDIES($bud,online) F
            set ::BUDDIES($bud,name) $bud
            set ::BUDDIES($bud,idle) 0
            set ::BUDDIES($bud,indexs) ""
            set ::BUDDIES($bud,popupText) ""
            set ::BUDDIES($bud,otherString) ""
            set ::BUDDIES($bud,uclass) ""
            incr ::GROUPS($group,total)
            lappend ::GROUPS($group,people) $bud
        } 
        "d" {
            set deny [string range $i 2 end]
            lappend ::DENYLIST $deny
        }
        "g" {
            set group [string range $i 2 end]
            lappend ::BUDDYLIST $group
            lappend ::GROUPS($group,collapsed) F
            set ::GROUPS($group,people) [list]
            set ::GROUPS($group,type) AIM
            set ::GROUPS($group,online) 0
            set ::GROUPS($group,total) 0
        }
        "m" {
            set ::PDMODE [string range $i 2 end]
        }
        "p" {
            set permit [string range $i 2 end]
            lappend ::PERMITLIST $permit
        }
        }
    }
}

# Update the user class display for a buddy
proc tik_update_uclass {bud} {
    switch -glob -- $::BUDDIES($bud,uclass) {
    "A?*" {
        set ::BUDDIES($bud,icon) AOL
    }
    "??U" {
        set ::BUDDIES($bud,icon) Away
    }
    "?A*" {
        set ::BUDDIES($bud,icon) Admin
    }
    "?O*" {
        set ::BUDDIES($bud,icon) Oscar
    }
    "?U*" {
        set ::BUDDIES($bud,icon) DT
    }
    default {
        set ::BUDDIES($bud,icon) ""
        return; 
    }
    } ;# SWITCH

    catch {
        foreach i $::BUDDIES($bud,indexs) {
            catch {sag::change_icon .buddy.list $i $::BUDDIES($bud,icon)}
        }
    }
}

# Update the popup text for a buddy
proc tik_update_ptext {bud} {
    set ::BUDDIES($bud,popupText) [list \
        $::BUDDIES($bud,name): ""\
        [tik_str BL_IDLE] $::BUDDIES($bud,idle) \
        [tik_str BL_EVIL] "$::BUDDIES($bud,evil)%" \
        [tik_str BL_ONLINE] ]

    if {$::BUDDIES($bud,online) == "T"} {
        lappend ::BUDDIES($bud,popupText) [clock format $::BUDDIES($bud,signon)]
    } else {
        lappend ::BUDDIES($bud,popupText) [tik_str BL_NOTONLINE]
    }

    lappend ::BUDDIES($bud,popupText) [tik_str BL_UCLASS]

    set class ""
    if {[string index $::BUDDIES($bud,uclass) 0] == "A"} {
        append class "AOL"
    }

    if {($class != "") && ([string index $::BUDDIES($bud,uclass) 1] != " ")} {
        append class ", "
    }

    switch -exact -- [string index $::BUDDIES($bud,uclass) 1] {
    "A" {
        append class "Admin"
    }
    "O" {
        append class "Oscar"
    }
    "U" {
        append class "Oscar Trial"
    }
    } ;# SWITCH
    lappend ::BUDDIES($bud,popupText) $class

    lappend ::BUDDIES($bud,popupText) [tik_str BL_STATUS]
    switch -exact -- [string index $::BUDDIES($bud,uclass) 2] {
    "U" {
        lappend ::BUDDIES($bud,popupText) [tik_str BL_STAT_AWAY]
    }
    default {
        lappend ::BUDDIES($bud,popupText) [tik_str BL_STAT_AVAIL]
    }
    } ;# SWITCH
}

# Change from the Login/Logout icon to a "normal" icon.
proc tik_removeicon {bud} {
    if {!$::TIK(online)} {
        return
    }

    set ::BUDDIES($bud,icon) ""
    catch {
        foreach i $::BUDDIES($bud,indexs) {
            catch {sag::change_icon .buddy.list $i ""}
        }
    }

    if {$::BUDDIES($bud,online) == "F"} {
        tik_draw_list F
    } else {
        tik_update_uclass $bud
    }
}

# Update the online/total counts for each of the groups.
proc tik_update_group_cnts {} {
    foreach g $::BUDDYLIST {
        set ::GROUPS($g,online) 0
        set ::GROUPS($g,total) 0
        foreach b $::GROUPS($g,people) {
            incr ::GROUPS($g,total)
            if {$::BUDDIES($b,online) != "F"} {
                incr ::GROUPS($g,online)
            }
        }

        if {$::TIK(options,showgrouptotals)} {
            set totals "($::GROUPS($g,online)/$::GROUPS($g,total))"
        } else {
            set totals ""
        }
        catch {sag::change_otherstring .buddy.list $::GROUPS($g,index) $totals}
    }
}

proc tik_draw_list { {clearFirst T}} {
    if { [winfo exists .buddy.list] == 0} {
        return
    }

    sag::icons_enable .buddy.list $::TIK(options,showicons)

    if {$clearFirst != "F"} {
        sag::remove_all .buddy.list
        foreach i $::BUDDYLIST {
            foreach j $::GROUPS($i,people) {
                set ::BUDDIES($j,indexs) ""
            }
        }
    }

    set n 0
    foreach i $::BUDDYLIST {
        if {$::TIK(options,showgrouptotals)} {
            set totals "($::GROUPS($i,online)/$::GROUPS($i,total))"
        } else {
            set totals ""
        }

        if {$::TIK(options,showicons)} {
            set indent 16
        } else {
            set indent 0
        }

        incr n
        if {$::GROUPS($i,collapsed) != "T"} {
            if {$clearFirst != "F"} {
                set ::GROUPS($i,index) [sag::add .buddy.list -10 "" "- $i" \
                    $totals \
                    $::TIK(options,groupmcolor) $::TIK(options,groupocolor)]
            }
            foreach j $::GROUPS($i,people) {
                set normj [normalize $::BUDDIES($j,name)]
                set normn [normalize [sag::pos_2_mainstring .buddy.list $n]]
                if {$::BUDDIES($j,online) == "T"} {
                    if {$normj != $normn} {
                        lappend ::BUDDIES($j,indexs) [sag::insert .buddy.list \
                            $n $indent $::BUDDIES($j,icon) $::BUDDIES($j,name) \
                            $::BUDDIES($j,otherString) \
                            $::TIK(options,buddymcolor) $::TIK(options,buddyocolor)]
                    }
                    incr n
                } else {
                    if {$normj == $normn} {
                        sag::remove .buddy.list [sag::pos_2_index .buddy.list $n]
                    }
                }
            }
        } else {
            if {$clearFirst != "F"} {
                set ::GROUPS($i,index) [sag::add .buddy.list -10 "" "+ $i" \
                    $totals \
                    $::TIK(options,groupmcolor) $::TIK(options,groupocolor)]
            }
        }
    }
}
#######################################################
# Routines for Warn Confirmation
#######################################################
proc p_tik_warn_send {name} {
    toc_evil $::NSCREENNAME $name $::TIK(warnanon)
    destroy .warn
}

proc tik_create_warn {name anon} {
    set w .warn
    if {[winfo exists $w]} {
        raise $w
        return
    }

    toplevel $w -class Tik
    wm title $w [tik_str WARN_TITLE $name]
    wm iconname $w [tik_str WARN_TITLE $name]
    if {$::TIK(options,windowgroup)} {wm group $w .login}

    bind $w <Motion> tik_non_idle_event

    set ::TIK(warnanon) $anon

    label $w.l1 -text [tik_str WARN_L1 $name]
    checkbutton $w.anon -text [tik_str WARN_ANON] -variable ::TIK(warnanon) \
        -onvalue T -offvalue F
    label $w.l2 -text [tik_str WARN_L2 $name]


    frame $w.buttonF
    button $w.warn -text [tik_str B_WARN] -command [list p_tik_warn_send $name]
    bind $w <Control-w> [list p_tik_warn_send $name]
    button $w.cancel -text [tik_str B_CANCEL] -command "destroy $w"
    bind $w <Control-period> "destroy $w"
    pack $w.warn $w.cancel -in $w.buttonF -side left -padx 2m

    pack $w.l1 $w.anon $w.l2 $w.buttonF -side top
}

#######################################################
# Routines for IM Conversations
#######################################################
proc p_tik_cim_send {name} {
    set w $::TIK(imconvs,$name,msgw)
    if { $::TIK(options,cimheight) == 0} {
        set msg [string trimright [$w get]]
    } else {
        set msg [string trimright [$w get 0.0 end]]
    }

    if { [string length [string trim $msg]] == 0} {
        tk_messageBox -type ok -message [tik_str E_NOMSG]
        return
    }

    if {$::TIK(options,imcolor)} {
        set msg "<FONT COLOR=\"$::TIK(imconvs,$name,color)\">$msg</FONT>"
    }

    if { [string length $msg] > 1950 } {
        tk_messageBox -type ok -message [tik_str E_MSGLONG]
        return
    }

    toc_send_im $::NSCREENNAME $::TIK(imconvs,$name,name) $msg

    if { $::TIK(options,cimheight) == 0} {
        $w delete 0 end
    } else {
        $w delete 0.0 end
    }
}

proc p_tik_cim_out {connName nick auto msg} {
    tik_receive_im $nick noauto $msg T
}

proc tik_msg_cim {name msg} {
    set nname [normalize $name]

    set w .imConv$nname
    if {![winfo exists $w]} {
        return
    }

    set wt $::TIK(imconvs,$nname,textw)
    $wt configure -state normal
    set tstr [clock format [clock seconds] -format [tik_str CIM_TIMESTAMP]]
    addHTML $wt $msg
    $wt configure -state disabled
}

proc tik_title_cim {name {oonline {UKN}} } {
    set nname [normalize $name]

    set w .imConv$nname
    if {![winfo exists $w]} {
        return
    }

    if {($oonline != "UKN") && ($oonline != $::BUDDIES($nname,online))} {
        set tstr [clock format [clock seconds] -format [tik_str CIM_TIMESTAMP]]
        if {$oonline == "T"} {
            tik_msg_cim $name [tik_str CIM_LOGOFF $name $tstr]
        } else {
            tik_msg_cim $name [tik_str CIM_LOGON $name $tstr]
        }
    }

    set extra [tik_str CIM_EXTRA00]

    catch {
        if {$::BUDDIES($nname,idle) != 0} {
            if {$::BUDDIES($nname,evil) != 0} {
                set extra [tik_str CIM_EXTRA11 $::BUDDIES($nname,idle)\
                              $::BUDDIES($nname,evil)]
            } else {
                set extra [tik_str CIM_EXTRA10 $::BUDDIES($nname,idle)]
            }
        } elseif {$::BUDDIES($nname,evil) != 0} {
            set extra [tik_str CIM_EXTRA01 $::BUDDIES($nname,evil)]
        }
    }

    if {$::TIK(imconvs,$nname,receiveLast)} {
        wm title $w [tik_str CIM_RTITLE $name $extra]
        wm iconname $w [tik_str CIM_RICON $name $extra]
    } else {
        wm title $w [tik_str CIM_STITLE $name $extra]
        wm iconname $w [tik_str CIM_SICON $name $extra]
    }
}

proc tik_create_cim {name} {
    set nname [normalize $name]

    set w .imConv$nname
    if {[winfo exists $w]} {
        tik_title_cim $name
        return
    }

    toplevel $w -class $::TIK(options,imWMClass)
    if {$::TIK(options,windowgroup)} {wm group $w .login}

    set ::TIK(imconvs,$nname,name) $name
    set ::TIK(imconvs,$nname,toplevel) $w
    set ::TIK(imconvs,$nname,textw) [createHTML $w.textF]
    set ::TIK(imconvs,$nname,flashing) 0
    set ::TIK(imconvs,$nname,background) [$w.textF.textS cget -background]

    set mw [createINPUT $w.msgArea cimheight]
    set ::TIK(imconvs,$nname,msgw) $mw

    frame $w.buttonF
    button $w.info -text [tik_str B_INFO] -command [list toc_get_info $::NSCREENNAME $nname]
    bind $w <Control-l> [list toc_get_info $::NSCREENNAME $nname]
    button $w.warn -text [tik_str B_WARN] -command [list tik_create_warn $name F]
    bind $w <Control-W> [list tik_create_warn $name T]
    button $w.send -text [tik_str B_SEND] -command "p_tik_cim_send $nname"
    if { [expr {$::TIK(options,msgsend) & 1} ] == 1} {
        bind $mw <Return> "p_tik_cim_send $nname; break"
    }
    if { [expr {$::TIK(options,msgsend) & 2} ] == 2} {
        bind $mw <Control-Return> "p_tik_cim_send $nname; break"
    } else {
        bind $mw <Control-Return> " "
    }
    bind $mw <Control-s> "p_tik_cim_send $nname; break"
    button $w.close -text [tik_str B_CLOSE] -command [list destroy $w]
    bind $mw <Control-period> [list destroy $w]
    pack $w.send $w.info $w.warn -in $w.buttonF -side left -padx 2m

    if {$::TIK(options,imcolor)} {
        set ::TIK(imconvs,$nname,color) $::TIK(options,defaultimcolor)
        button $w.color -text [tik_str B_COLOR] -command [list tik_set_color imconvs [tik_str CIM_COL_TITLE] $nname]
        pack $w.color -in $w.buttonF -side left -padx 2m
    }
    
    if {![tik_is_buddy $nname]} {
        button $w.add -text [tik_str B_ADD] -command "tik_create_add buddy \"$name\";destroy $w.add"
        pack $w.add -in $w.buttonF -side left -padx 2m
    }

    pack $w.close -in $w.buttonF -side left -padx 2m

    pack $w.buttonF -side bottom
    if {($::TIK(options,cimheight) != 0) && $::TIK(options,cimexpand)} {
        pack $w.msgArea -fill both -side bottom -expand 1
    } else {
        pack $w.msgArea -fill x -side bottom
    }
    pack $w.textF -expand 1 -fill both -side top

    tik_title_cim $name
    focus $mw

    bind $w <Motion> tik_non_idle_event
    bind $w <Enter> "tik_flash_im $nname 0"
}

proc tik_flash_im {nremote doflash} {
    set w .imConv$nremote
    if {![winfo exists $w]} {
        return
    }

    if {$doflash == 0} {
        $w.textF.textS configure \
            -background $::TIK(imconvs,$nremote,background)
        set ::TIK(imconvs,$nremote,flashing) 0
        return
    } 

    if {! $::TIK(imconvs,$nremote,flashing)} {
        return
    }

    if {$doflash == 1} {
        $w.textF.textS configure \
            -background $::TIK(options,flashimcolor)
        after $::TIK(options,flashimtime) tik_flash_im $nremote 2
    } elseif {$doflash == 2} {
        $w.textF.textS configure \
            -background $::TIK(imconvs,$nremote,background)
        after $::TIK(options,flashimtime) tik_flash_im $nremote 1
    }
}

proc tik_receive_im {remote auto msg us} {
    set nremote [normalize $remote]

    if {$us == "T"} {
        tik_play_sound2 $nremote Send
    } else {
        tik_play_sound2 $nremote Receive
    }

    set autostr ""
    if { ($auto == "auto") || ($auto == "T") } {
        set autostr [tik_str CIM_AUTORESP]
    }

    set ::TIK(imconvs,$nremote,receiveLast) [string compare $us "T"]

    tik_create_cim $remote
    set w $::TIK(imconvs,$nremote,textw)
    $w configure -state normal
    if {$::TIK(options,imtime)} {
        set tstr [clock format [clock seconds] -format [tik_str CIM_TIMESTAMP]]
    } else {
        set tstr ""
    }
    if {$us == "T"} {
        $w insert end "$tstr$::SCREENNAME$autostr: " bbold
    } else {
        $w insert end "$tstr$remote$autostr: " rbold
    }
    addHTML $w "$msg" $::TIK(options,imcolor)
    addHTML $w "\n"
    $w configure -state disabled

    if {$::TIK(options,raiseim)} {
        raise $::TIK(imconvs,$nremote,toplevel)
    }

    if {$::TIK(options,deiconifyim)} {
        wm deiconify $::TIK(imconvs,$nremote,toplevel)
    }

    # Only do flash if a) the option is on b) the message wasn't
    # from us c) our mouse isn't over the window already.
    if {$::TIK(options,flashim) && ($us == "F")} {
        set pwin [winfo containing [winfo pointerx .] [winfo pointery .]]
        if {($pwin == "") || 
            ([winfo toplevel $pwin] != $::TIK(imconvs,$nremote,toplevel))} {
            set ::TIK(imconvs,$nremote,flashing) 1
            tik_flash_im $nremote 1
        }
    }
}


#######################################################
# Routines for sending an initial IM
#######################################################
proc p_tik_iim_send {id} {
    set to $::TIK(iims,$id,to)
    if { $::TIK(options,iimheight) == 0} {
        set msg [string trimright [$::TIK(iims,$id,msgw) get]]
    } else {
        set msg [string trimright [$::TIK(iims,$id,msgw) get 0.0 end]]
    }

    set w $::TIK(iims,$id,toplevel)

    if { [string length [string trim $msg]] == 0} {
        tk_messageBox -type ok -message [tik_str E_NOMSG]
        return
    }

    if {$::TIK(options,imcolor)} {
        set msg "<FONT COLOR=\"$::TIK(options,defaultimcolor)\">$msg</FONT>"
    }

    if { [string length $msg] > 1950 } {
        tk_messageBox -type ok -message [tik_str E_MSGLONG]
        return
    }

    destroy $w
    toc_send_im $::NSCREENNAME $to $msg
}

proc tik_create_iim {cname name} {
    set cnt 0
    catch {set cnt $::TIK(iims,cnt)}
    set ::TIK(iims,cnt) [expr $cnt + 1]

    set ::TIK(iims,$cnt,to) $name

    set w .iim$cnt
    set ::TIK(iims,$cnt,toplevel) $w

    toplevel $w -class $::TIK(options,imWMClass)
    wm title $w [tik_str IIM_TITLE]
    wm iconname $w [tik_str IIM_ICON]
    if {$::TIK(options,windowgroup)} {wm group $w .login}

    bind $w <Motion> tik_non_idle_event

    frame $w.top
    label $w.toL -text [tik_str IIM_TO]
    entry $w.to -width 16 -relief sunken -textvariable ::TIK(iims,$cnt,to)
    pack  $w.toL $w.to -in $w.top -side left

    set tw [createINPUT $w.textArea iimheight]
    set ::TIK(iims,$cnt,msgw) $tw
    bind $w.to <Return> [list focus $tw]

    bind $w <F1> "$tw insert current ayt?"

    if { [expr {$::TIK(options,msgsend) & 1} ] == 1} {
        bind $tw <Return> "p_tik_iim_send $cnt; break"
    }
    if { [expr {$::TIK(options,msgsend) & 2} ] == 2} {
        bind $tw <Control-Return> "p_tik_iim_send $cnt; break"
    } else {
        bind $tw <Control-Return> " "
    }


    frame $w.bottom
    button $w.send -text [tik_str B_SEND] -command [list p_tik_iim_send $cnt]
    bind $w <Control-s> "p_tik_iim_send $cnt; break"
    button $w.cancel -text [tik_str B_CANCEL] -command [list destroy $w]
    bind $w <Control-period> [list destroy $w]
    pack $w.send $w.cancel -in $w.bottom -side left -padx 2m

    pack $w.top -side top
    pack $w.bottom -side bottom
    pack $w.textArea -expand 1 -fill both
    if { $name == ""} {
        focus $w.to
    } else {
        focus $tw
    }
}
#######################################################
# Routines for doing a Chat Invite
#######################################################
proc p_tik_invite_send {id} {
    set roomid $::TIK(cinvites,$id,roomid)
    set msg $::TIK(cinvites,$id,msg)
    set loc $::TIK(cinvites,$id,loc)
    set peoplew $::TIK(cinvites,$id,peoplew)
    set w $::TIK(cinvites,$id,toplevel)

    if { [string length [string trim $msg]] == 0} {
        tk_messageBox -type ok -message [tik_str E_NOMSG]
        return
    }

    if { [string length $msg] > 200 } {
        tk_messageBox -type ok -message [tik_str E_MSGLONG]
        return
    }

    if { [string length [string trim $loc]] == 0} {
        tk_messageBox -type ok -message [tik_str E_NEEDLOC]
        return
    }

    if { [string length $loc] > 50 } {
        tk_messageBox -type ok -message [tik_str E_LOCLONG]
        return
    }

    set ::TIK(invites,$loc,people) [$peoplew get 0.0 end]
    set ::TIK(invites,$loc,msg) $msg

    if {$roomid != "" } {
        CHAT_JOIN $::NSCREENNAME $roomid $loc
    } else {
        toc_chat_join $::NSCREENNAME 4 $loc
    }
    destroy $w
}
proc p_tik_invite_add {id} {
    set sel [sag::selection .buddy.list]
    set peoplew $::TIK(cinvites,$id,peoplew)

    if {$sel == ""} {
        return
    }

    foreach s $sel {
        set c [string index $s 0]
        if {$c == "+" || $c == "-"} {
            set g [string range $s 2 end]
            if {$::GROUPS($g,type) != "AIM"} {
                continue
            }
            foreach i $::GROUPS($g,people) {
                if {$::BUDDIES($i,online) == "T"} {
                    $peoplew insert end "$::BUDDIES($i,name)\n"
                }
            }
        } else {
            $peoplew insert end "[string trim $s]\n"
        }
    }
}
proc tik_create_invite {{roomid ""} {loc ""}} {
    set cnt 0
    catch {set cnt $::TIK(cinvites,cnt)}
    set ::TIK(cinvites,cnt) [expr $cnt + 1]

    set ::TIK(cinvites,$cnt,roomid) $roomid
    set ::TIK(cinvites,$cnt,msg) [tik_str CINVITE_MSG]

    if {$loc == ""} {
        set ::TIK(cinvites,$cnt,loc) "$::SCREENNAME chat[expr int(rand() * 10000)]"
    } else {
        set ::TIK(cinvites,$cnt,loc) $loc
    }

    set w .invite$cnt
    toplevel $w -class $::TIK(options,chatWMClass)
    wm title $w [tik_str CINVITE_TITLE]
    wm iconname $w [tik_str CINVITE_ICON]
    if {$::TIK(options,windowgroup)} {wm group $w .login}
    set ::TIK(cinvites,$cnt,toplevel) $w

    bind $w <Motion> tik_non_idle_event

    label $w.inviteL -text [tik_str CINVITE_DIR]
    text $w.invite -font $::NORMALFONT -width 40
    set ::TIK(cinvites,$cnt,peoplew) $w.invite
    label $w.messageL -text [tik_str CINVITE_MSGL]
    entry $w.message -font $::NORMALFONT -textvariable ::TIK(cinvites,$cnt,msg) -width 40
    bind $w.message <Return> [list focus $w.location]
    label $w.locationL -text [tik_str CINVITE_LOCL]
    entry $w.location -font $::NORMALFONT -textvariable ::TIK(cinvites,$cnt,loc) -width 40
    bind $w.location <Return> "p_tik_invite_send $cnt; break"

    frame $w.buttons
    button $w.send -text [tik_str B_SEND] -command [list p_tik_invite_send $cnt]
    bind $w <Control-s> "p_tik_invite_send $cnt; break"
    button $w.add -text [tik_str B_ADD] -command [list p_tik_invite_add $cnt]
    bind $w <Control-a> [list p_tik_invite_add $cnt]
    button $w.cancel -text [tik_str B_CANCEL] -command [list destroy $w]
    bind $w <Control-period> [list destroy $w]
    pack $w.send $w.add $w.cancel -in $w.buttons -side left -padx 2m

    pack $w.inviteL $w.invite $w.messageL $w.message $w.locationL $w.location $w.buttons

    if {$loc != ""} {
        $w.location configure -state disabled
    }

    p_tik_invite_add $cnt
}

#######################################################
# Routines for doing a Chat Accept
#######################################################
proc p_tik_accept_send {w id} {
    destroy $w
    toc_chat_accept $::NSCREENNAME $id
}
proc tik_create_accept {loc id name msg} {
    set w .accept$id

    toplevel $w -class $::TIK(options,chatWMClass)
    wm title $w [tik_str CACCEPT_TITLE $name]
    wm iconname $w [tik_str CACCEPT_ICON $name]
    if {$::TIK(options,windowgroup)} {wm group $w .login}

    bind $w <Motion> tik_non_idle_event

    label $w.msg -text $msg
    label $w.loc -text [tik_str CACCEPT_LOC $loc]

    frame $w.buttons
    button $w.accept -text [tik_str B_ACCEPT] -command [list p_tik_accept_send $w $id]
    bind $w <Control-a> [list p_tik_accept_send $w $id]
    button $w.im -text [tik_str B_IM] -command [list tik_create_iim $::NSCREENNAME $name]
    bind $w <Control-i> [list tik_create_iim $::NSCREENNAME $name]
    button $w.info -text [tik_str B_INFO] -command [list toc_get_info $::NSCREENNAME $name]
    bind $w <Control-l> [list toc_get_info $::NSCREENNAME $name]
    button $w.warn -text [tik_str B_WARN] -command [list tik_create_warn $name F]
    bind $w <Control-W> [list tik_create_warn $name T]
    button $w.cancel -text [tik_str B_CANCEL] -command [list destroy $w]
    bind $w <Control-period> [list destroy $w]
    pack $w.accept $w.info $w.warn $w.cancel -in $w.buttons -side left -padx 2m

    pack $w.msg $w.loc $w.buttons
}

#######################################################
# Routines for doing a Chat Room
#######################################################
proc p_tik_chat_send {id whisper} {
    set w $::TIK(chats,$id,msgw)
    if { $::TIK(options,chatheight) == 0} {
        set msg [string trimright [$w get]]
    } else {
        set msg [string trimright [$w get 0.0 end]]
    }

    if { [string length [string trim $msg]] == 0} {
        tk_messageBox -type ok -message [tik_str E_NOMSG]
        return
    }

    if {$::TIK(options,chatcolor)} {
        set msg "<FONT COLOR=\"$::TIK(chats,$id,color)\">$msg</FONT>"
    }

    if { [string length $msg] > 950 } {
        tk_messageBox -type ok -message [tik_str E_MSGLONG]
        return
    }

    if {$whisper == "T"} {
        set sel [sag::selection $::TIK(chats,$id,list)]
        if {$sel == ""} {
            tk_messageBox -type ok -message [tik_str E_NEEDWHISPER]
            return
        } else {
            toc_chat_whisper $::NSCREENNAME $id $sel $msg
            tik_receive_chat $id $::NSCREENNAME S $msg $sel
        }
    } else {
        toc_chat_send $::NSCREENNAME $id $msg
    }

    if { $::TIK(options,chatheight) == 0} {
        $w delete 0 end
    } else {
        $w delete 0.0 end
    }
}

proc tik_leave_chat {id} {
    if {[winfo exists $::TIK(chats,$id,toplevel)]} {
        destroy $::TIK(chats,$id,toplevel)
    }

    foreach i [array names ::TIK "chats,$id,*"] {
        unset ::TIK($i)
    }
}

proc p_tik_chat_close {id} {
    toc_chat_leave $::NSCREENNAME $id
    destroy $::TIK(chats,$id,toplevel)
}

proc tik_create_chat {id name} {
    set w .chats$id
    if {[winfo exists $w]} {
        return
    }

    toplevel $w -class $::TIK(options,chatWMClass)
    wm title $w [tik_str CHAT_TITLE $name]
    wm iconname $w [tik_str CHAT_ICON $name]
    if {$::TIK(options,windowgroup)} {wm group $w .login}
    set ::TIK(chats,$id,toplevel) $w
    set ::TIK(chats,$id,name) $name

    bind $w <Motion> tik_non_idle_event

    frame $w.left

    set ::TIK(chats,$id,textw) [createHTML $w.textF]

    frame $w.msgF

    set mw [createINPUT $w.msgArea chatheight 30]
    set ::TIK(chats,$id,msgw) $mw

    if { [expr {$::TIK(options,msgsend) & 1} ] == 1} {
        bind $mw <Return> "p_tik_chat_send $id F; break"
    }
    if { [expr {$::TIK(options,msgsend) & 2} ] == 2} {
        bind $mw <Control-Return> "p_tik_chat_send $id F; break"
    } else {
        bind $mw <Control-Return> " "
    }
    button $w.send -text [tik_str B_SEND] -command [list p_tik_chat_send $id F]
    button $w.whisper -text [tik_str B_WHISPER] -command [list p_tik_chat_send $id T]
    pack $w.send $w.whisper -in $w.msgF -side right
    pack $w.msgArea -in $w.msgF -side left -fill x -expand 1

    pack $w.msgF -in $w.left -fill x -side bottom
    pack $w.textF -in $w.left -fill both -expand 1 -side top

    frame $w.right

    sag::init $w.list 100 100 1 $::SAGFONT #a9a9a9 $::TIK(options,sagborderwidth)
    set ::TIK(chats,$id,list) $w.list

    frame $w.r1
    button $w.ignore -text [tik_str B_IGNORE] -state disabled
    button $w.warn -text [tik_str B_WARN] -command [list tik_lselect $w.list toc_evil] -state disabled
    #bind $w <Control-W> [list tik_lselect $w.list toc_evil T]
    pack $w.ignore $w.warn -in $w.r1 -side left

    frame $w.r2
    button $w.info -text [tik_str B_INFO] -command [list tik_lselect $w.list tik_get_info]
    bind $w <Control-l> [list tik_lselect $w.list tik_get_info]
    button $w.im -text [tik_str B_IM] -command [list tik_lselect $w.list tik_create_iim ]
    bind $w <Control-i> [list tik_lselect $w.list tik_create_iim ]
    if {$::TIK(options,chatcolor)} {
        button $w.invite -text [tik_str B_INVITE] -command [list tik_create_invite $id $name]
        bind $w <Control-v> [list tik_create_invite $id $name]
        pack $w.info $w.im $w.invite -in $w.r2 -side left
    } else {
        pack $w.info $w.im -in $w.r2 -side left
    }

    frame $w.r3
    if {$::TIK(options,chatcolor)} {
        set ::TIK(chats,$id,color) $::TIK(options,defaultchatcolor)
        button $w.color -text [tik_str B_COLOR] -command [list tik_set_color chats [tik_str CHAT_COL_TITLE] $id]
        pack $w.color -in $w.r3 -side left
    } else {
        button $w.invite -text [tik_str B_INVITE] -command [list tik_create_invite $id $name]
        bind $w <Control-v> [list tik_create_invite $id $name]
        pack $w.invite -in $w.r3 -side left
    }
    button $w.close -text [tik_str B_CLOSE] -command [list p_tik_chat_close $id]
    wm protocol $w WM_DELETE_WINDOW [list p_tik_chat_close $id]
    bind $w <Control-period> [list p_tik_chat_close $id]
    pack $w.close -in $w.r3 -side left

    pack $w.list -in $w.right -expand 1 -fill both
    pack $w.r1 $w.r2 $w.r3 -in $w.right

    pack $w.right -side right -expand 0 -fill both
    pack $w.left  -side left -expand 1 -fill both
    focus $mw
}

proc tik_receive_chat {id remote whisper msg {whispersto {}}} {
    if {[normalize $remote] == $::NSCREENNAME} {
        tik_play_sound $::TIK(SOUND,ChatSend)
    } else {
        tik_play_sound $::TIK(SOUND,ChatReceive)
    }

    set whisperstr ""
    if { $whisper == "T" } {
        set whisperstr [tik_str CHAT_WHISPER]
    } elseif { $whisper == "S" } {
        set whisperstr [tik_str CHAT_WHISPERTO $whispersto]
    }

    set w $::TIK(chats,$id,toplevel)

    if {[winfo exists $w] == 0} {
        return
    }

    if {$::TIK(options,chattime)} {
        set tstr [clock format [clock seconds] -format [tik_str CHAT_TIMESTAMP]]
    } else {
        set tstr ""
    }

    set textw $::TIK(chats,$id,textw)

    $textw configure -state normal
    $textw insert end "$tstr$remote$whisperstr: " bold
    addHTML $textw "$msg" $::TIK(options,chatcolor)
    addHTML $textw "\n"
    $textw configure -state disabled

    if {$::TIK(options,raisechat)} {
        raise $w
    }

    if {$::TIK(options,deiconifychat)} {
        wm deiconify $w
    }
}

#######################################################
# setStatus - Set the status label in the login dialog
#######################################################
proc setStatus {str} {
    .login.status configure -text $str
}

#######################################################
# tik_show_login - Show the login window, we first withdraw
# the buddy window in case it is around.
#######################################################
proc tik_show_login {} {
    if {[winfo exists .buddy]} {
        wm withdraw .buddy
    }

    if {[winfo exists .login]} {
        wm deiconify .login
        raise .login
    }
}
#######################################################
# Routines for proxy stuff
#######################################################
proc tik_noneproxy_config {} {
    set w .proxyconfig
    destroy $w
}

#######################################################
# tik_create_login - 
#######################################################
proc tik_strs_login {} {
    wm title .login [tik_str LOGIN_TITLE]
    wm iconname .login [tik_str LOGIN_ICON]
    .login.tocl configure -text [tik_str LOGIN_TOCL]
    .login.authl configure -text [tik_str LOGIN_AUTHL]
    .login.snL configure -text [tik_str LOGIN_SNL]
    .login.pwL configure -text [tik_str LOGIN_PASSL]
    .login.bF.register configure -text [tik_str LOGIN_REGL] \
        -command "tik_show_url register [tik_str LOGIN_REGURL]"
    .login.bF.signon configure -text [tik_str LOGIN_SIGNL]
    .login.prF.label configure -text [tik_str LOGIN_PROXYL]
    .login.prF.config configure -text [tik_str PROXY_CONFIG]
    bind .login <Control-r> "tik_show_url register [tik_str LOGIN_REGURL]"
}

proc tik_create_login {} {
    if {[winfo exists .login]} {
        destroy .login
    }

    toplevel .login -class Tik
    wm command .login [concat $::argv0 $::argv]
    wm group .login .login

    wm withdraw .login

    image create photo logo -file media/Logo.gif

    label .login.logo -image logo
    label .login.status

    frame .login.tocF
    label .login.tocl -width 13
    eval tk_optionMenu .login.tocs ::SELECTEDTOC $::TOCS
    .login.tocs configure -width 16
    pack .login.tocl .login.tocs -in .login.tocF -side left -expand 1

    frame .login.authF
    label .login.authl -width 13
    eval tk_optionMenu .login.auths ::SELECTEDAUTH $::AUTHS
    .login.auths configure -width 16
    pack .login.authl .login.auths -in .login.authF -side left -expand 1

    frame .login.snF
    entry .login.snE -font $::NORMALFONT -width 16 -relief sunken -textvariable ::SCREENNAME 
    label .login.snL -width 13
    pack .login.snL .login.snE -in .login.snF -side left -expand 1

    frame .login.pwF
    label .login.pwL -width 13
    entry .login.pwE -font $::NORMALFONT -width 16 -relief sunken -textvariable ::PASSWORD -show "*"
    pack .login.pwL .login.pwE -in .login.pwF -side left -expand 1

    frame .login.bF
    button .login.bF.register 
    button .login.bF.signon -command tik_signon
    pack .login.bF.register .login.bF.signon -side left -expand 1

    frame .login.prF -border 1 -relief solid
    label .login.prF.label 

    menubutton .login.prF.proxies -textvariable ::USEPROXY -indicatoron 1 \
            -menu .login.prF.proxies.menu \
            -relief raised -bd 2 -highlightthickness 2 -anchor c \
            -direction flush
    menu .login.prF.proxies.menu -tearoff 0

    tik_register_proxy None "" "tik_noneproxy_config"

    button .login.prF.config -command \
        {$::TIK(proxies,$::USEPROXY,configFunc)}
    pack .login.prF.label .login.prF.proxies .login.prF.config -side left -expand 1

    tik_strs_login

    pack .login.logo .login.status .login.tocF .login.authF .login.snF \
         .login.pwF .login.bF .login.prF -expand 0 -fill x -ipady 1m

    bind .login.snE <Return> { focus .login.pwE }
    bind .login.pwE <Return> { tik_signon }
    bind .login <Control-s> { tik_signon }
    bind .login <Control-r> "tik_show_url register [tik_str LOGIN_REGURL]"
    focus .login.snE

    wm protocol .login WM_DELETE_WINDOW {destroy .}
}

##########################################################
# Routine to register for single click middle button stuff
##########################################################
proc tik_register_buddy_button_func {btype name cb} {
    set ::TIK(BBUT,$btype,$name,callback) $cb
    set b3popup .bbuttonpopup$btype
    if {![winfo exists $b3popup]} {
        menu $b3popup -tearoff 0
    }
    .bbuttonpopup$btype add command -label $name -command \
        "tik_register_buddy_button_cb {$btype} {$name}"
}

proc tik_unregister_buddy_button_func {btype name} {
    .bbuttonpopup$btype delete $name
    set ::TIK(BBUT,$btype,$name,callback) ""
}

proc tik_register_buddy_button_cb {btype name} {
    if {$::TIK(BBUT,pname) != ""} {
        $::TIK(BBUT,$btype,$name,callback) $::NSCREENNAME $::TIK(BBUT,pname)
    }
}


proc tik_popup_buddy_window {y X Y} {
   set ::TIK(BBUT,pname) $y
   set norm [normalize $y]
   if {[winfo exists .bbuttonpopup$::BUDDIES($norm,type)]} {
        tk_popup .bbuttonpopup$::BUDDIES($norm,type) $X $Y
   }
}

proc tik_buddy_button3_press {y X Y} {
    set str [sag::pos_2_mainstring .buddy.list [sag::nearest .buddy.list $y]]
    set f [string index $str 0]
    if {($f == "+") || ($f == "-")} {
        return
    }
    if {$str != ""} {
        tik_popup_buddy_window $str $X $Y
    }
}

#######################################################
# Routines for proxy stuff
#######################################################
proc tik_noneproxy_config {} {
    set w .proxyconfig
    destroy $w

    toplevel $w -class Tik
    wm title $w [tik_str PROXY_TITLE]
    wm iconname $w [tik_str PROXY_ICON]
    if {$::TIK(options,windowgroup)} {wm group $w .login}
    label $w.label -text [tik_str PROXY_MSG]

    frame $w.tochostF
    label $w.tochostF.l -text [tik_str PROXY_TOCH]
    entry $w.tochostF.e -textvariable ::TOC($::SELECTEDTOC,host) \
        -exportselection 0
    pack $w.tochostF.l $w.tochostF.e -side left

    frame $w.tocportF
    label $w.tocportF.l -text [tik_str PROXY_TOCP]
    entry $w.tocportF.e -textvariable ::TOC($::SELECTEDTOC,port) \
        -exportselection 0
    pack $w.tocportF.l $w.tocportF.e -side left

    button $w.ok -text [tik_str B_OK] -command "destroy $w"
    pack $w.label $w.tochostF $w.tocportF $w.ok -side top
}

proc tik_register_proxy {name connFunc configFunc} {
    set ::TIK(proxies,$name,connFunc) $connFunc
    set ::TIK(proxies,$name,configFunc) $configFunc
    .login.prF.proxies.menu add radiobutton -label $name -variable ::USEPROXY
}

proc tik_unregister_proxy {name} {
    .login.prF.proxies.menu delete $name
}

#######################################################
# Routines for doing a Buddy Add
#######################################################
proc p_tik_add_send {id} {
    set group $::TIK(adds,$id,group)
    set name $::TIK(adds,$id,name)
    set w $::TIK(adds,$id,toplevel)

    if {[string length [normalize $group]] < 2} {
        tk_messageBox -type ok -message [tik_str E_NEEDBGROUP]
        return
    }

    if {[string length [normalize $name]] < 2} {
        tk_messageBox -type ok -message [tik_str E_NEEDBNAME]
        return
    }

    if {$::TIK(adds,$id,mode) == "pd"} {
        tik_add_pd $group [normalize $name]
    } else {
        tik_add_buddy $group [normalize $name]
    }

    # Only send config if not in edit mode
    if {(![winfo exists .edit]) && (![winfo exists .pd])} {
        tik_set_config
    }

    $w.buddyname delete 0 end
    focus $w.buddyname
}

proc tik_create_add {{mode {buddy}} {name {}}} {
    set cnt 0
    catch {set cnt $::TIK(adds,cnt)}
    set ::TIK(adds,cnt) [expr $cnt + 1]

    set w .add$cnt
    toplevel $w -class Tik
    set ::TIK(adds,$cnt,toplevel) $w
    set ::TIK(adds,$cnt,mode) $mode
    set ::TIK(adds,$cnt,name) $name
    wm title $w [tik_str ADDB_TITLE]
    wm iconname $w [tik_str ADDB_ICON]
    if {$::TIK(options,windowgroup)} {wm group $w .login}

    frame $w.top
    label $w.buddynameL -text [tik_str ADDB_NAME]
    entry $w.buddyname -font $::NORMALFONT -width 16 -textvariable ::TIK(adds,$cnt,name)
    if {$mode == "buddy"} {
        bind $w.buddyname <Return> [list focus $w.buddygroup]
    } else {
        bind $w.buddyname <Return> [list p_tik_add_send $cnt]
    }
    pack $w.buddynameL $w.buddyname -in $w.top -side left

    frame $w.middle
    label $w.buddygroupL -text [tik_str ADDB_GROUP]


    if {$mode == "buddy"} {
        eval tk_optionMenu $w.m ::TIK(adds,$cnt,group) $::BUDDYLIST
        $w.m configure -width 16
        entry $w.buddygroup -font $::NORMALFONT -width 16 -textvariable ::TIK(adds,$cnt,group)
        pack $w.buddygroup -in $w.middle -side right
        bind $w.buddygroup <Return> [list p_tik_add_send $cnt]
    } else {
        tk_optionMenu $w.m ::TIK(adds,$cnt,group) Permit Deny
        $w.m configure -width 16
    }
    pack $w.buddygroupL $w.m -in $w.middle -side left

    frame $w.bottom
    button $w.add -text [tik_str B_ADD] -command [list p_tik_add_send $cnt]
    bind $w <Control-a> [list p_tik_add_send $cnt]
    button $w.cancel -text [tik_str B_CLOSE] -command [list destroy $w]
    bind $w <Control-period> [list destroy $w]
    pack $w.add $w.cancel -in $w.bottom -side left -padx 2m

    pack $w.top $w.middle $w.bottom

    focus $w.buddyname
}

#######################################################
# Routines for doing buddy edit
#######################################################
proc tik_edit_draw_list { {group ""} {name ""}} {
    if {[winfo exists .edit] != 1} {
        return
    }

    if {$name == ""} {
        .edit.list delete 0 end

        foreach g $::BUDDYLIST {
            .edit.list insert end $g
            foreach j $::GROUPS($g,people) {
                .edit.list insert end "   $::BUDDIES($j,name)"
            }
        }
    } else {
        set n 0
        set s [.edit.list size]
        while {1} {
            if {$group == [.edit.list get $n]} {
                break
            }
            incr n
        }
        incr n
        while { ($n < $s) } {
            set t [.edit.list get $n]
            if {[string index $t 0] != " "} {
                break
            }
            incr n
        }
        .edit.list insert $n "   $name"
    }
}

proc p_tik_edit_remove {} {
    set n [.edit.list curselection]
    if { $n == "" } {
        return
    }

    set name [.edit.list get $n]


    if {[string index $name 0] == " "} {
        .edit.list delete $n
        set norm [normalize $name]
        foreach i $::BUDDYLIST {
            incr n -1
            set c 0
            foreach j $::GROUPS($i,people) {
                if {$n == 0} {
                    set ::GROUPS($i,people) [lreplace $::GROUPS($i,people) $c $c]
                    if {[tik_is_buddy $j] == 0} {
                        toc_remove_buddy $::NSCREENNAME $j
                    }
                    break
                }
                incr n -1
                incr c
            }
            if {$n == 0} {
                break
            }
        }
    } else {
        set c 0
        foreach i $::BUDDYLIST {
            if {$i == $name} {
                set ::BUDDYLIST [lreplace $::BUDDYLIST $c $c]
                break
            }
            incr c
        }

        set g $::GROUPS($name,people)
        unset ::GROUPS($name,people)
        unset ::GROUPS($name,collapsed)
        foreach i $g {
            if {[tik_is_buddy $i] == 0} {
                toc_remove_buddy $::NSCREENNAME $i
            }
        }
        tik_edit_draw_list
    }
    tik_update_group_cnts
}

proc p_tik_edit_close {} {
    tik_set_config
    tik_draw_list
    destroy .edit
}

proc tik_create_edit {} {
    if {[winfo exists .edit]} {
        raise .edit
        tik_edit_draw_list
        return
    }

    toplevel .edit -class Tik
    wm title .edit [tik_str EDIT_TITLE]
    wm iconname .edit [tik_str EDIT_ICON]
    if {$::TIK(options,windowgroup)} {wm group .edit .login}

    frame .edit.listf
    scrollbar .edit.scroll -orient vertical -command [list .edit.list yview]
    listbox .edit.list -exportselection false -yscrollcommand [list .edit.scroll set] 
    pack .edit.scroll -in .edit.listf -side right -fill y
    pack .edit.list -in .edit.listf -side left -expand 1 -fill both

    frame .edit.buttons
    button .edit.add -text [tik_str B_ADD] -command tik_create_add
    bind .edit <Control-a> tik_create_add
    button .edit.remove -text [tik_str B_REMOVE] -command p_tik_edit_remove
    bind .edit <Control-r> p_tik_edit_remove
    button .edit.close -text [tik_str B_CLOSE] -command p_tik_edit_close
    bind .edit <Control-period> p_tik_edit_close
    pack .edit.add .edit.remove .edit.close -in .edit.buttons -side left -padx 2m

    pack .edit.buttons -side bottom
    pack .edit.listf -fill both -expand 1 -side top
    tik_edit_draw_list
}

#######################################################
# Routines for doing permit deny
#######################################################

proc tik_pd_draw_list { {group ""} {name ""}} {
    if {[winfo exists .pd] != 1} {
        return
    }

    .pd.list delete 0 end

    .pd.list insert end "Permit"
    foreach i $::PERMITLIST {
        .pd.list insert end "   $i"
    }
    .pd.list insert end "Deny"
    foreach i $::DENYLIST {
        .pd.list insert end "   $i"
    }
}

proc p_tik_pd_remove {} {
    set n [.pd.list curselection]
    if { $n == "" } {
        return
    }
    incr n -1
    set k 0
    foreach i $::PERMITLIST {
        if {$n == 0} {
            set ::PERMITLIST [lreplace $::PERMITLIST $k $k]
        }
        incr k
        incr n -1
    }

    incr n -1
    set k 0
    foreach i $::DENYLIST {
        if {$n == 0} {
            set ::DENYLIST [lreplace $::DENYLIST $k $k]
        }
        incr k
        incr n -1
    }

    tik_pd_draw_list
}

proc p_tik_pd_close {} {
    tik_set_config
    destroy .pd

    # This will flash us, but who cares, I am lazy. :(
    toc_add_permit $::NSCREENNAME
    toc_add_deny $::NSCREENNAME

    # Set everyone off line since we will get updates
    foreach g $::BUDDYLIST {
        foreach b $::GROUPS($g,people) {
            if {$::BUDDIES($b,type) == "AIM"} {
                set ::BUDDIES($b,online) F
            }
        }
    }
    tik_draw_list

    # Send up the data
    if {$::PDMODE == "3"} {
        toc_add_permit $::NSCREENNAME $::PERMITLIST
    } elseif {$::PDMODE == "4"} {
        toc_add_deny $::NSCREENNAME $::DENYLIST
    }
}

proc tik_create_pd {} {
    if {[winfo exists .pd]} {
        raise .pd
        tik_pd_draw_list
        return
    }

    toplevel .pd -class Tik
    wm title .pd [tik_str PD_TITLE]
    wm iconname .pd [tik_str PD_ICON]
    if {$::TIK(options,windowgroup)} {wm group .pd .login}

    frame .pd.radios
    radiobutton .pd.all -value 1 -variable ::PDMODE \
       -text [tik_str PD_MODE_1]
    radiobutton .pd.permit -value 3 -variable ::PDMODE \
       -text [tik_str PD_MODE_3]
    radiobutton .pd.deny -value 4 -variable ::PDMODE \
       -text [tik_str PD_MODE_4]
    pack .pd.all .pd.permit .pd.deny -in .pd.radios

    frame .pd.listf
    scrollbar .pd.scroll -orient vertical -command [list .pd.list yview]
    listbox .pd.list -exportselection false -yscrollcommand [list .pd.scroll set] 
    pack .pd.scroll -in .pd.listf -side right -fill y
    pack .pd.list -in .pd.listf -side left -expand 1 -fill both

    frame .pd.buttons
    button .pd.add -text [tik_str B_ADD] -command "tik_create_add pd"
    bind .pd <Control-a> tik_create_add
    button .pd.remove -text [tik_str B_REMOVE] -command p_tik_pd_remove
    bind .pd <Control-r> p_tik_pd_remove
    button .pd.close -text [tik_str B_CLOSE] -command p_tik_pd_close
    bind .pd <Control-period> p_tik_pd_close
    pack .pd.add .pd.remove .pd.close -in .pd.buttons -side left -padx 2m

    pack .pd.buttons -side bottom
    pack .pd.radios .pd.listf -fill both -expand 1 -side top
    tik_pd_draw_list
}

#######################################################
# Routines for INFO
#######################################################
proc tik_set_info {info} {
    set ::TIK(INFO,msg) $info
    set ::TIK(INFO,sendinfo) 1
}

proc p_tik_setinfo_set {} {
    if {![winfo exists .setinfo.text]} {
        return
    }

    set ::TIK(INFO,msg) [.setinfo.text get 0.0 end]
    set ::TIK(INFO,sendinfo) 1
    toc_set_info $::NSCREENNAME $::TIK(INFO,msg)
    destroy .setinfo
}

proc tik_show_version {} {
    set w .showver

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

    toplevel $w -class Tik
    wm title $w [tik_str ABOUT_TITLE $::VERSION]
    wm iconname $w [tik_str ABOUT_ICON $::VERSION]

    image create photo logo -file media/Logo.gif

    label .showver.logo -image logo
    label .showver.status


    label $w.info1 -text [tik_str INFO_L1]
    label $w.info2 -text [tik_str INFO_L2 $::VERSION]

    sag::init $w.list 300 100 1 $:::SAGFONT #a9a9a9 $::TIK(options,sagborderwidth)

    set files [lsort -ascii [glob -nocomplain -- $::TIK(pkgDir)/*.tcl]]
    foreach pkg $files {
        set pkgname [file rootname [file tail $pkg] ]
        set version "*UNKNOWN*"
        set versdate "*UNKNOWN*"
        set ocolor red
        catch {
            set version [set ::${pkgname}::VERSION]
            set versdate [set ::${pkgname}::VERSDATE]
            set ocolor black
        }
        sag::add $w.list 0 "" $pkgname "$version ($versdate)" black $ocolor
    }

    frame $w.buttons
    button $w.cancel -text [tik_str B_OK] -command [list destroy $w]
    pack $w.cancel -in $w.buttons -side left -padx 2m
    pack .showver.logo .showver.status
    pack $w.info1 -side top
    pack $w.info2 -side top
    pack $w.buttons -side bottom
    pack $w.list -fill both -expand 1 -padx 2m -side top
}


proc tik_create_setinfo {} {
    set w .setinfo

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

    toplevel $w -class Tik
    wm title $w [tik_str INFO_TITLE]
    wm iconname $w [tik_str INFO_ICON]
    if {$::TIK(options,windowgroup)} {wm group $w .login}

    text  $w.text -width 40 -height 10 -wrap word
    $w.text insert end $::TIK(INFO,msg)

    label $w.info -text [tik_str INFO_MSG]
    frame $w.buttons
    button $w.set -text [tik_str B_SETINFO] -command "p_tik_setinfo_set"
    button $w.cancel -text [tik_str B_CANCEL] -command [list destroy $w]
    pack $w.set $w.cancel -in $w.buttons -side left -padx 2m

    pack $w.info -side top
    pack $w.buttons -side bottom
    pack $w.text -fill both -expand 1 -side top
}

#######################################################
# Routines for montior config files and packages
#######################################################

# tik_check_rc --
#     Montior the ~/.tik/tikrc file for changes.  The method
#     is called by a timer.

proc tik_check_rc {} {
    after $::TIK(options,monitorrctime) tik_check_rc
    if { ! $::TIK(options,monitorrc) || ! [file exists $::TIK(rcfile)] } {
        return
    }

    file stat $::TIK(rcfile) vals

    if {$vals(mtime) != $::TIK(rcfile,mtime)} {
        puts "$::TIK(rcfile) changed, reloading."
        set ::TIK(rcfile,mtime) $vals(mtime)
        source $::TIK(rcfile)
    }
}

# tik_check_pkg --
#     This routine is called to load the packages.  It is also
#     called as a timer callback that checks so often for
#     changes in the packages.
#
# Arguments:
#     timer - 1 if this is a timer callback.
proc tik_check_pkg {{timer {0}}} {

    if {$timer} {
        after $::TIK(options,monitorpkgtime) tik_check_pkg 1
    }

    if { ($timer && ! $::TIK(options,monitorpkg) ) || 
         ! [file exists $::TIK(pkgDir)] } {
        return
    }

    set files [lsort -ascii [glob -nocomplain -- $::TIK(pkgDir)/*.tcl]]
    foreach pkg $files {
        file stat $pkg vals
        set pkgname [file rootname [file tail $pkg] ]
        if {![info exists ::TIK(pkg,$pkg,mtime)]} {
            set ::TIK(pkg,$pkg,mtime) $vals(mtime)
            set ::TIK(pkg,$pkg,pkgname) $pkgname
            source $pkg
            ${pkgname}::load
        } elseif {$vals(mtime) != $::TIK(pkg,$pkg,mtime)} {
            puts "Need to reload package $pkgname from $pkg"
            set ::TIK(pkg,$pkg,mtime) $vals(mtime)
            catch {${pkgname}::unload} ;# This should print out 
                                        # the error on failure someday.
            namespace forget $pkgname
            source $pkg
            ${pkgname}::load
            if {$::TIK(online)} {
                ${pkgname}::goOnline
            }
        }
    }
}

proc tik_default_set {var val} {
    if {![info exists ::TIK($var)]} {
        set ::TIK($var) $val
    }
}
#######################################################
# Capability routines

proc tik_add_capability {cap} {
    if {[lsearch -exact $::TIK(CAPS) $cap] != -1} {
        return
    }
    lappend ::TIK(CAPS) $cap
    if {$::TIK(online)} {
        toc_set_caps \"$::SCREENNAME\" $::TIK(CAPS)
    }
}

proc tik_remove_capability {cap} {
    set i [lsearch -exact $::TIK(CAPS) $cap]
    if {$i == -1} {
        return
    }
    set ::TIK(CAPS) [lreplace $::TIK(CAPS) $i $i]
    if {$::TIK(online)} {
        toc_set_caps $::SCREENNAME $::TIK(CAPS)
    }
}

#######################################################
# String Routines
#######################################################
proc tik_set_str {name value} {
    set ::TIK(STRINGS,$name) $value
}

proc tik_str {name args} {
    set str $::TIK(STRINGS,$name)
    set omsg ""
    set inp 0
    foreach i [split $str {}] {
        if {$inp} {
            switch -exact -- $i {
            "n" {append omsg $::SCREENNAME}
            "N" {append omsg $::NSCREENNAME}
            "i" {append omsg [expr [clock seconds] - $::TIK(IDLE,last_event)]}
            "I" {append omsg [expr ([clock seconds] - $::TIK(IDLE,last_event))/60]}
            "e" {append omsg $::TIK(EVIL,level)}
            "0" -
            "1" -
            "2" -
            "3" -
            "4" {append omsg [lindex $args $i]}
            "%" {append omsg "%"}
            }
            set inp 0
        } elseif {$i == "%"} {
            set inp 1
        } else {
            append omsg $i
        }
    }
    return $omsg
}

proc tik_strs_menu {} {
    .languageMenu delete 0 end
    foreach file [lsort -ascii [glob "strs/*.strs"]] {
        set v [string range $file 5 [expr [string length $file] - 6]]
        .languageMenu add radiobutton -variable ::TIK(options,language) \
            -value $v -label $v -command tik_load_strs
    }
}

proc tik_load_strs {{initial 0}} {
    if {!$initial} {
        destroy .menubar
        foreach package [lsort -ascii [array names ::TIK pkg,*,pkgname]] {
            set pkgname $::TIK($package)
            catch {${pkgname}::unload}
        }
    }

    if {[file exists strs/$::TIK(options,dlanguage).strs]} {
        source strs/$::TIK(options,dlanguage).strs
    }

    if {($::TIK(options,language) != $::TIK(options,dlanguage)) && 
        [file exists strs/$::TIK(options,language).strs]} {
        source strs/$::TIK(options,language).strs
    }

    if {[file exists $::TIK(strsfile)]} {
        source $::TIK(strsfile)
    }

    if {!$initial} {
        tik_create_menubar
        .buddy configure -menu .menubar
        tik_strs_buddy
        tik_strs_login
        foreach package [lsort -ascii [array names ::TIK pkg,*,pkgname]] {
            set pkgname $::TIK($package)
            catch {
                ${pkgname}::load
                ${pkgname}::goOnline
            }
        }
    }
}

#######################################################
# MAIN
#######################################################

# Globals
set ::TIK(INFO,sendinfo) 0
set ::TIK(INFO,msg) ""
set ::TIK(IDLE,sent) 0
set ::TIK(IDLE,timer) 0
set ::TIK(EVIL,level) 0
set ::TIK(IDLE,last_event) [clock seconds]
set ::TIK(IDLE,XY) [winfo pointerxy .]
set ::TIK(configDir) "~/.tik"
set ::TIK(rcfile,mtime) 0
set ::TIK(online) 0
set ::TIK(CAPS) ""

set ::USEPROXY None

# Default OPTIONS
set ::TIK(options,imtime)     1    ;# Display timestamps in IMs?
set ::TIK(options,chattime)   1    ;# Display timestamps in Chats?

# Heights:  
#   ==  0 :One Line Entry.  Resizing keeps it 1 line
#   >=  1 :Text Entry, Multiline.  Resizing may increase number of lines
#   <= -1 :Text Entry, Multiline.  Same as >=1 but with scroll bar.
set ::TIK(options,iimheight)  4    ;# Initial IM Entry Height
set ::TIK(options,cimheight)  0    ;# Converation IM Entry Height
set ::TIK(options,chatheight) 0    ;# Chat Entry Height

set ::TIK(options,cimexpand)   0   ;# If cimheight is not 0, then this
                                   ;# determins if the entry area expands
                                   ;# on resize.

set ::TIK(options,imcolor)          1           ;# Process IM colors?
set ::TIK(options,defaultimcolor)   "#000000"   ;# Default IM color
set ::TIK(options,chatcolor)        1           ;# Process Chat colors?
set ::TIK(options,defaultchatcolor) "#000000"   ;# Default Chat color

set ::TIK(options,flashim)          1           ;# Flash IM sb when new msg
set ::TIK(options,flashimtime)      500         ;# ms between flashes
set ::TIK(options,flashimcolor)     blue        ;# Flash color is

set ::TIK(options,windowgroup)   0     ;# Group all TiK windows together? 
set ::TIK(options,raiseim)       0     ;# Raise IM window on new message
set ::TIK(options,deiconifyim)   0     ;# Deiconify IM window on new message
set ::TIK(options,raisechat)     0     ;# Raise Chat window on new message
set ::TIK(options,deiconifychat) 0     ;# Deiconify Chat window on new message
set ::TIK(options,monitorrc)     1     ;# Monitor rc file for changes?
set ::TIK(options,monitorrctime) 20000 ;# Check for rc file changes how often (millisecs)
set ::TIK(options,monitorpkg)     1     ;# Monitor pkgs for changes?
set ::TIK(options,monitorpkgtime) 20000 ;# Check the pkg dir for changes how often (millisecs)

set ::TIK(options,showgrouptotals) 1    ;# Show the group totals
set ::TIK(options,showidletime)    1    ;# Show the idle time of buddies
set ::TIK(options,showicons)       1    ;# Show the icons
set ::TIK(options,padframe)        1    ;# Pad Buddy Window?
set ::TIK(options,sagborderwidth)  2    ;# Border width for sag windows.
set ::TIK(options,removedelay)    10000 ;# Buddy removal delay when departing.

# 0 - Enter/Ctl-Enter insert NewLine,  Send Button Sends
# 1 - Ctl-Enter inserts NewLine,  Send Button/Enter Sends
# 2 - Enter inserts NewLine,  Send Button/Ctl-Enter Sends
# 3 - No Newlines,  Send Button/Ctl-Enter/Enter Sends
set ::TIK(options,msgsend) 1

# 0 - Use the config from the host
# 1 - Use the config from ~/.tik/NSCREENNAME.config
# 2 - Use the config from ~/.tik/NSCREENNAME.config & keep this config
#     on the host.  (Remember the host has a 2k config limit!)
# 3 - Use the config from the host, but backup locally, if host config
#     is empty then use local config.
set ::TIK(options,localconfig) 3

# 0 - Don't report idle time
# 1 - Report idle time
set ::TIK(options,reportidle) 1
set ::TIK(options,idlewatchmouse) 1    ;# Watch the global mouse pointer
set ::TIK(options,reportidleafter) 900 ;# Report idle after this long (secs)

# Buddy Colors
set ::TIK(options,buddymcolor) black
set ::TIK(options,buddyocolor) blue
set ::TIK(options,groupmcolor) black
set ::TIK(options,groupocolor) red

# Sound Names
set ::TIK(SOUND,ChatSend)    media/Send.au
set ::TIK(SOUND,ChatReceive) media/Receive.au
set ::TIK(SOUND,Send)        media/Send.au
set ::TIK(SOUND,Receive)     media/Receive.au
set ::TIK(SOUND,Arrive)      media/BuddyArrive.au
set ::TIK(SOUND,Depart)      media/BuddyLeave.au

# Window Manager Classes
set ::TIK(options,imWMClass) Tik
set ::TIK(options,chatWMClass) Tik

set ::TIK(options,persistent) 0 ;# Reconnect when accidentally disconnected

set ::TIK(options,dlanguage) English ;# Default strs file to use
set ::TIK(options,language)  English ;# Override defaults fromstrs file to use

# Register the callbacks, we are cheesy and use the
# same function names as the message names.
toc_register_func * SIGN_ON           SIGN_ON
toc_register_func * CONFIG            CONFIG
toc_register_func * NICK              NICK
toc_register_func * IM_IN             IM_IN
toc_register_func * toc_send_im       IM_OUT
toc_register_func * UPDATE_BUDDY      UPDATE_BUDDY
toc_register_func * ERROR             ERROR
toc_register_func * EVILED            EVILED
toc_register_func * CHAT_JOIN         CHAT_JOIN
toc_register_func * CHAT_IN           CHAT_IN
toc_register_func * CHAT_UPDATE_BUDDY CHAT_UPDATE_BUDDY
toc_register_func * CHAT_INVITE       CHAT_INVITE
toc_register_func * CHAT_LEFT         CHAT_LEFT
toc_register_func * GOTO_URL          GOTO_URL
toc_register_func * PAUSE             PAUSE
toc_register_func * CONNECTION_CLOSED CONNECTION_CLOSED

# Set up the fonts that we use for all "entry" and "text" widgets.
# First we create a fake label and find out the font Tk uses for
# that.  We use this as the defaults for the rest.  
label .fonttest
set ::TIKFONTINFO [font actual [.fonttest cget -font]]
destroy .fonttest
set ::SAGFONT [eval font create $::TIKFONTINFO -family helvetica -size -12 -weight normal ]
set ::NORMALFONT [eval font create $::TIKFONTINFO -weight normal ]
set ::BOLDFONT [eval font create $::TIKFONTINFO -weight bold]
set ::ITALICFONT [eval font create $::TIKFONTINFO -weight normal -slant italic]

proc argCheck {arg i l} {
    if {$i >= $l} {
        puts "$::argv0: Missing argument for $arg, try -H for usage."
        exit 1;
    }
}

# Parse Options
set largv [llength $argv]
for {set i 0} {$i < $largv} {incr i} {
    set arg [lindex $argv $i]
    switch -glob -- $arg {
    "-H" -
    "-h" -
    "-help" {
        puts "$argv0 Usage:"
        puts " -H             This message"
        puts " -sflap <level> SFLAP debug level"
        puts " -config <dir>  Use <dir> instead of ~/.tik"
        puts " -user <user>   Use <user>, overrides rc files"
        puts " -pass <pass>   User <pass>, overrides rc files"
        puts " -roast <pass>  Roast a password for use in ~/.tik"
        exit 0
    }
    "-sflap" {
        incr i
        argCheck $arg $i $largv
        set sflap::debug_level [lindex $argv $i]
    }
    "-dir*" -
    "-config*" {
        incr i
        argCheck $arg $i $largv
        set ::TIK(configDir) [lindex $argv $i]
    }
    "-prefile" -
    "-rcfile" {
        puts "The option $arg is no longer supported, instead use -config <dir>"
        exit 0
    }
    "-u" - 
    "-user" {
        incr i
        argCheck $arg $i $largv
        set ::TIK(clUser) [lindex $argv $i]
    }
    "-p" - 
    "-pass" {
        incr i
        argCheck $arg $i $largv
        set ::TIK(clPass) [lindex $argv $i]
    }
    "-roast" {
        incr i
        argCheck $arg $i $largv
        puts -nonewline "\nPlace \"set PASSWORD "
        puts "0x[roast_password [lindex $argv $i]]\" in your $::TIK(configDir)/tikrc file.\n"
        puts -nonewline "WARNING: While not in clear text, people can still "
        puts "decode your password."
        exit 0
    }
    default {
        puts "$::argv0: Unknown argument '$arg', try -H for usage."
        exit 1;
    }
    } ;# SWITCH
}

set ::TIK(prefile) $::TIK(configDir)/tikpre
set ::TIK(rcfile) $::TIK(configDir)/tikrc
set ::TIK(strsfile) $::TIK(configDir)/tikstrs
set ::TIK(pkgDir) packages
set ::SCREENNAME ""
set ::NSCREENNAME ""

if {[file exists ~/.tikrc]} {
    puts -nonewline "This version of TiK now uses ~/.tik/tikrc instead "
    puts "of ~/.tikrc.  You should:"
    puts "   mkdir ~/.tik"
    puts "   mv ~/.tikrc ~/.tik/tikrc"
    puts "   mv ~/.tikpre ~/.tik/tikpre"
} elseif { ! [file exists $::TIK(configDir)] } {
    catch {
        puts "$::VERSION:  Copyright (c) 1998-9 America Online, Inc. All Rights Reserved."
        puts "Please read tik/COPYING and tik/LICENSE"
        puts ""
        puts "Creating the directory $::TIK(configDir)"
        file mkdir $::TIK(configDir)
        catch {exec chmod og-rwx $::TIK(configDir)}
        puts "Copying example config files to $::TIK(configDir)"
        if {[file exists example.tikrc]} {
            puts "Copying example config files to $::TIK(configDir)"
            file copy example.tikrc $::TIK(configDir)/tikrc
            file copy example.tikpre $::TIK(configDir)/tikpre
            file copy example.tikstrs $::TIK(configDir)/tikstrs
        } else {
            puts "This distribution of TiK did not come with the example config files."
            puts "Please visit http://www.aim.aol.com/tik for the full TiK distribution."
        }
    }
} elseif { [file exists $::TIK(configDir)/packages] } {
    puts "This release only uses packages installed in the TiK home dir."
    puts "You no longer need $::TIK(configDir)/packages"
}

# Load the pre user config
if {[file exists $::TIK(prefile)] == 1} {
    source $::TIK(prefile)
}

tik_load_strs 1

# Create the windows
tik_create_login
tik_create_buddy

# Show the login screen and set the initial status to the version of TiK.
tik_show_login
setStatus $VERSION

# Load the packages
tik_check_pkg 0

# Load the user config
if {[file exists $::TIK(rcfile)] == 1} {
    source $::TIK(rcfile)
    file stat $::TIK(rcfile) info
    set ::TIK(rcfile,mtime) $info(mtime)
}

catch {set SCREENNAME $TIK(clUser)}
catch {set PASSWORD $TIK(clPass)}

tik_check_rc
tik_check_pkg 1

#######################################################
# SOCKET routines
#
# This makes all sockets async so we don't block
# events while trying to connect.  However we will
# block during the internal DNS looking still.  These
# are defined after the packages are loaded, incase
# the packages do something tricky with sockets also.
#######################################################

# First rename the old real socket routine
if {[info command real_socket] == ""} {
    rename socket real_socket
}

proc socketcheck {conn var count} {
    #puts "$conn $var $count"
    if {[catch {fconfigure $conn -peername}] == 0} {
        set $var 1
        return
    }
    incr count -1
    if {$count == 0} {
        set $var 0
    } else {
        after 100 socketcheck $conn $var $count
    }
}

proc socket {args} {
    for {set i 0} {$i < [llength $args]} {incr i} {
        set arg [lindex $args $i]
        if {[string match "-s*" $arg ]} {
            return [eval real_socket $args]
        } elseif {[string index $arg 0] == "-"} {
            error "tik socket routine doesn't support - options"
        } 
        break;
    }

    if {$sflap::debug_level > 0} {
        puts "START socket: $args"
    }
    set host [lindex $args $i]
    set port [lindex $args [expr $i +1]]

    set conn [real_socket -async $host $port]
    after 100 socketcheck $conn ::socket$conn 20
    vwait ::socket$conn
    if {[set ::socket$conn] == 1} {
        unset ::socket$conn
        return $conn
    } else {
        unset ::socket$conn
        error "Couldn't connect to $host:$port"
    }
    if {$sflap::debug_level > 0} {
        puts "STOP socket: $args"
    }
}

# don't use this anymore
proc tik_ping {args} {}