#!/usr/bin/wish
###############################################################
### ccmsn					###############
### http://msn.CompuCreations.com/		###############
### Dave Mifsud <dave at CompuCreations dot com>###############
###						###############
### Version 0.3p3 20010926			###############
###############################################################
###
### Compu's Messenger - ccmsn
### Copyright (C) 2001 Dave Mifsud
###
### 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; version 2 of the License
###
### 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
###

source %%PREFIX%%/share/ccmsn/migmd5.tcl

set version "0.3p3"
#=======================================================================
set images_folder "%%PREFIX%%/share/ccmsn/i"

set emotions {{":-)" smile} {":)" smile} {":-D" smiled} {":D" smiled}
	{":->" smiled} {":>" smiled} {":-O" smileo} {":O" smileo} {":-P" smilep}
	{":P" smilep} {";-)" wink} {";)" wink} {":-(" sad} {":(" sad}
	{":-<" sad} {":<" sad} {":-S" crooked} {":S" crooked} {":-|" disgust}
	{":|" disgust} {"(Y)" thumbu} {"(N)" thumbd} {"(L)" love} {"(U)" unlove}
	{"(K)" lips} {"(G)" gift} {"(F)" rose} {"(X)" emgirl} {"(Z)" emboy}
	{"(P)" photo} {"(B)" beer} {"(D)" coctail} {"(T)" emphone} {"(@)" emcat}
	{"(C)" emcup} {"(I)" embulb} {"(H)" emhottie} {"(S)" emsleep}
	{"(*)" emstar} {"(8)" emnote} {"(E)" email} {"(M)" messenger}
	{":-[" vampire} {":[" vampire}}

set emotion_files {smile smiled smileo smilep wink sad crooked disgust thumbu
	thumbd love unlove lips gift rose emgirl emboy photo beer coctail
	emphone emcat emcup embulb emhottie emsleep emstar emnote email
	messenger vampire}
#=======================================================================
set trid 0

set user_info ""
set user_stat "FLN"
set list_fl [list]
set list_rl [list]
set list_al [list]
set list_bl [list]
set list_users [list]
set list_notify [list]
set list_cmdhnd [list]

set sb_num 0
set sb_list [list]
set sb_list_cal [list]

set status_show 0

set config(login) ""			;# These are defaults for users without
set config(save_password) 0		;# a config file
set config(keep_logs) 0
set config(proxy) ""
set config(start_ns_server) "messenger.hotmail.com:1863"
set config(last_client_version) ""

set password ""

set list_states {{NLN Online #0000FF online online}
		{IDL Idle #0000A0 online away}
		{BRB "Be Right Back" #0000C0 online away}
		{PHN "On The Phone" #0000C0 online busy}
		{BSY Busy #C00000 online busy}
		{AWY Away #00A000 online away}
		{LUN "Out To Lunch" #00A000 online away}
		{HDN "Appear Offline" #404040 offline offline}
		{FLN Offline #404040 offline offline}}
#=======================================================================
if {$tcl_platform(platform) == "unix"} {
   set HOME "$env(HOME)/.ccmsn"
} else {
   set HOME "ccmsn"
}

set log_dir "${HOME}/logs"
#=======================================================================
for {set i 1} {$i <= 256} {incr i} {
   set c [format %c $i]
   if {![string match \[a-zA-Z0-9\] $c]} {
      set url_map($c) %[format %.2X $i]
   }
}
#=======================================================================
proc create_dir {path} {
   global tcl_platform

   if {[file isdirectory $path] == 0} {
      file mkdir $path
      if {$tcl_platform(platform) == "unix"} {
         file attributes $path -permissions 00700
      }
   }
}

proc save_config {} {
   global tcl_platform config HOME version password

   if {$tcl_platform(platform) == "unix"} {
      set file_id [open "${HOME}/config" w 00600]
   } else {
      set file_id [open "${HOME}/config" w]
   }
   puts $file_id "ccmsn_config_version 1"
   set config(last_client_version) $version

   set config_entries [array get config]
   set items [llength $config_entries]
   for {set idx 0} {$idx < $items} {incr idx 1} {
      set var_attribute [lindex $config_entries $idx]; incr idx 1
      set var_value [lindex $config_entries $idx]
      puts $file_id "$var_attribute $var_value"
   }
   if {$config(save_password)} {
      puts $file_id "password ${password}"
   }
   close $file_id
}

proc load_config {} {
   global config HOME password

   if {([file readable "${HOME}/config"] == 0) ||
       ([file isfile "${HOME}/config"] == 0)} {
      return 1
   }
   set file_id [open "${HOME}/config" r]
   gets $file_id tmp_data
   if {$tmp_data != "ccmsn_config_version 1"} {	;# config version not supported!
      return 1
   }
   while {[gets $file_id tmp_data] != "-1"} {
      set var_data [split $tmp_data]
      set var_attribute [lindex $var_data 0]
      set var_value [lindex $var_data 1]
      set config($var_attribute) $var_value
   }
   if {[info exists config(password)]} {
      set password $config(password)
      unset config(password)
   }
   close $file_id
}
#=======================================================================
proc cmsn_draw_about {} {
   toplevel .about
   wm title .about "About Compu's Messenger"
   wm transient .about .

   text .about.info -background white -width 60 -height 30 -wrap word \
      -yscrollcommand ".about.ys set"
   scrollbar .about.ys -command ".about.info yview" -background #C0C0C0
   pack .about.ys -side right -fill y
   pack .about.info -expand true -fill both
   set id [open "%%PREFIX%%/share/ccmsn/README" r]
   .about.info insert 1.0 [read $id]
   close $id
   .about.info configure -state disabled
   update idletasks
   set x [expr ([winfo vrootwidth .about] - [winfo width .about]) / 2]
   set y [expr ([winfo vrootheight .about] - [winfo height .about]) / 2]
   wm geometry .about +${x}+${y}
}

proc toggle_status {} {
   global status_show

   if {$status_show} {
      wm state .status withdraw
      set status_show 0
   } else {
      wm state .status normal
      set status_show 1
   }
}

proc status_log {txt {colour ""}} {

   set timestamp [clock format [clock seconds] -format %H:%M:%S]
   .status.info insert end "\[$timestamp\] $txt" $colour
   .status.info yview moveto 1.0

}

proc cmsn_draw_main {} {
   global images_folder emotion_files

   menu .my_menu -tearoff 0 -type normal -background #C0C0C0
   .my_menu add command -label "Online" -command "change_my_status NLN"
   .my_menu add command -label "Busy" -command "change_my_status BSY"
   .my_menu add command -label "Be Right Back" -command "change_my_status BRB"
   .my_menu add command -label "Away" -command "change_my_status AWY"
   .my_menu add command -label "On The Phone" -command "change_my_status PHN"
   .my_menu add command -label "Out To Lunch" -command "change_my_status LUN"
   .my_menu add command -label "Appear Offline" -command "change_my_status HDN"

   menu .user_menu -tearoff 0 -type normal -background #C0C0C0

   menu .main_menu -tearoff 0 -type menubar -background #C0C0C0 \
      -borderwidth 0 -activeborderwidth -0
   .main_menu add cascade -label CCMSN -menu .main_menu.msn
   .main_menu add cascade -label Message -menu .main_menu.msg -state disabled
   .main_menu add command -label About -command cmsn_draw_about

   menu .main_menu.msn -tearoff 0 -type normal -background #C0C0C0
   .main_menu.msn add command -label "Sign in..." -command cmsn_draw_login
   .main_menu.msn add command -label "Sign out" -state disabled \
      -command cmsn_logout
   .main_menu.msn add cascade -label "My Status" -state disabled -menu .my_menu
   .main_menu.msn add separator
   .main_menu.msn add command -label "Add a Contact" -state disabled \
      -command cmsn_draw_addcontact
   .main_menu.msn add separator
   .main_menu.msn add command -label "Change Display Name" -state disabled \
      -command cmsn_change_name
   .main_menu.msn add separator
   .main_menu.msn add command -label "Proxy settings" -command cmsn_proxy
   .main_menu.msn add separator
   .main_menu.msn add command -label "Close" -command exit

   menu .main_menu.msg -tearoff 0 -type normal -background #C0C0C0
   .main_menu.msg add separator
   .main_menu.msg add command -label "Other..." -command send_im_other -state disabled

   #toplevel .main
   wm title . "Compu's Messenger - offline"
   wm geometry . -0+0
   wm iconname . "Compu's Messenger"
   . conf -menu .main_menu

   frame .main
   pack .main -expand true -fill both

   image create photo online -file ${images_folder}/online.gif
   image create photo offline -file ${images_folder}/offline.gif
   image create photo away -file ${images_folder}/away.gif
   image create photo busy -file ${images_folder}/busy.gif
   image create photo blocked -file ${images_folder}/blocked.gif

   foreach img_name $emotion_files {
      image create photo $img_name -file ${images_folder}/${img_name}.gif
   }

   text .main.text -background white -width 30 -height 30 -wrap none \
      -yscrollcommand ".main.ys set" -cursor left_ptr
   scrollbar .main.ys -command ".main.text yview" -background #C0C0C0
   text .main.status -background #C0C0C0 -width 30 -height 1 -wrap none

   pack .main.status -side bottom -fill x
   pack .main.ys -side right -fill y
   pack .main.text -expand true -fill both

   .main.status configure -state disabled
   .main.text configure -state disabled
   bind .main.status <Double-Button-3> toggle_status

   cmsn_draw_status
   cmsn_draw_offline
}

proc cmsn_draw_status {} {
   toplevel .status
   wm state .status withdraw
   wm title .status "status log - Compu's Messenger"

   text .status.info -background white -width 60 -height 30 -wrap word \
      -yscrollcommand ".status.ys set"
   scrollbar .status.ys -command ".status.info yview" -background #C0C0C0
   entry .status.enter -background white

   pack .status.enter -side bottom -fill x
   pack .status.ys -side right -fill y
   pack .status.info -expand true -fill both

   .status.info tag configure green -foreground darkgreen -background white
   .status.info tag configure red -foreground red -background white
   .status.info tag configure white -foreground white -background black

   bind .status.enter <Return> ns_enter
   wm protocol .status WM_DELETE_WINDOW { toggle_status }
}

proc cmsn_draw_offline {} {

   wm title . "Compu's Messenger - offline"

   .main.status configure -state normal
   .main.status delete 0.0 end
   .main.status insert end "Offline"
   .main.status configure -state disabled

   .main.text configure -state normal
   .main.text delete 0.0 end
   .main.text tag conf start_login -fore #0000A0 -underline true \
   -font {Courier -12 bold} -justify center
   .main.text tag bind start_login <Enter> \
	    ".main.text tag conf start_login -fore #0000FF -underline false"
   .main.text tag bind start_login <Leave> \
	    ".main.text tag conf start_login -fore #0000A0 -underline true"
   .main.text tag bind start_login <Button-1> \
	    "cmsn_draw_login"
   .main.text insert end "\n\n\n\n\n"
   .main.text insert end "Click here to sign in" start_login
   .main.text configure -state disabled

   .main_menu entryconfigure 1 -state disabled
   .main_menu.msn entryconfigure 0 -state normal
   .main_menu.msn entryconfigure 1 -state disabled
   .main_menu.msn entryconfigure 2 -state disabled
   .main_menu.msn entryconfigure 4 -state disabled
   .main_menu.msn entryconfigure 6 -state disabled
   .main_menu.msn entryconfigure 8 -state normal
}

proc cmsn_draw_signin {} {

   .main.status configure -state normal
   .main.status delete 0.0 end
   .main.status insert end "Signing In..."
   .main.status configure -state disabled

   .main.text configure -state normal
   .main.text delete 0.0 end
   .main.text tag conf signin -fore #000000 \
   -font {Courier -12 bold} -justify center
   .main.text insert end "\n\n\n\n\n"
   .main.text insert end "Signing In..." signin
   .main.text insert end "\n"
   .main.text configure -state disabled

}

proc cmsn_draw_login {} {
   global config password login_request

   if {[info exists login_request]} {
      raise .login
      return 0
   }

   set login_request true
   toplevel .login
   bind .login <Destroy> {if {"%W" == ".login"} { unset login_request } }

   wm geometry .login -0+100
   wm title .login "Sign in - Compu's Messenger"
   wm transient .login .
   canvas .login.c -width 400 -height 150 -bg #C0C0C0
   pack .login.c -expand true -fill both

   entry .login.c.signin -width 20 -bg #FFFFFF -bd 1 -font {Courier -14 bold}
   entry .login.c.password -width 20 -bg #FFFFFF -bd 1 \
      -font {Courier -14 bold} -show "*"
   button .login.c.ok -text OK -command login_ok -bg #C0C0C0
   button .login.c.cancel -text Cancel -bg #C0C0C0 \
      -command "grab release .login;destroy .login"

   checkbutton .login.c.remember -bg #C0C0C0 -variable config(save_password) \
      -text "Remember my password"  -activebackground #C0C0C0 \
      -highlightthickness 0 -activeforeground #FFFFFF -selectcolor #FFFFFF

   .login.c create text 133 10 -font {Helvetica 12 bold} -anchor ne \
	-text "Sign-in name: "
   .login.c create text 133 80 -font {Helvetica 12 bold} -anchor ne \
	-text "Password: "
   .login.c create text 133 32 -font {Helvetica 10} -anchor ne \
	-text "Examples: "
   .login.c create text 133 32 -font {Helvetica 10} -anchor nw \
	-text "gudidu@hotmail.com\nmyname@msn.com\nexample@passport.com"
   .login.c create window 133 10 -window .login.c.signin -anchor nw
   .login.c create window 133 80 -window .login.c.password -anchor nw
   .login.c create window 133 100 -window .login.c.remember -anchor nw
   .login.c create window 195 120 -window .login.c.ok -anchor ne
   .login.c create window 205 120 -window .login.c.cancel -anchor nw

   .login.c.signin insert 0 $config(login)
   .login.c.password insert 0 $password

   bind .login.c.password <Return> "login_ok"

   tkwait visibility .login
   grab set .login
}

proc cmsn_draw_online {} {
   global user_stat login list_users list_states user_info list_bl

   set my_name [urldecode [lindex $user_info 4]]
   set my_state_no [lsearch $list_states "$user_stat *"]
   set my_state [lindex $list_states $my_state_no]
   set my_state_desc [lindex $my_state 1]
   set my_colour [lindex $my_state 2]
   set my_image_type [lindex $my_state 4]

   .main.status configure -state normal
   .main.status delete 0.0 end
   .main.status insert end $my_state_desc
   .main.status configure -state disabled

   .main.text configure -state normal
   .main.text delete 0.0 end

   .main.text tag conf mystatus -fore $my_colour -underline true
   .main.text tag bind mystatus <Button-1> "tk_popup .my_menu %X %Y"
   .main.text tag bind mystatus <Button-3> "tk_popup .my_menu %X %Y"

   .main.text tag conf online -fore #000000 -font {Courier -12 bold}
   .main.text tag conf offline -fore #000000 -font {Courier -12 bold}

   .main.text insert end "\n"
   .main.text image create end -image $my_image_type -pady 2 -padx 3
   .main.text insert end "$my_name ($my_state_desc)\n" mystatus
   .main.text insert end "\nOnline\n" online
   .main.text insert end "\nOffline\n" offline

   foreach user $list_users {
      set user_login [lindex $user 0]
      set user_name [lindex $user 1]
      set user_state_no [lindex $user 2]
      set state [lindex $list_states $user_state_no]
      set state_code [lindex $state 0]
      if {($state_code != "NLN") && ($state_code !="FLN")} {
         set state_desc " ([lindex $state 1])"
      } else {
         set state_desc ""
      }
      set colour [lindex $state 2]
      set section [lindex $state 3]
      set image_type [lindex $state 4]
      if {[lsearch $list_bl "$user_login *"] != -1} {
         set image_type "blocked"
	 if {$state_desc == ""} {set state_desc " (Blocked)"}
      }

      .main.text tag conf $user_login -fore $colour
      .main.text insert $section.last "$user_name$state_desc\n" $user_login
      .main.text image create $section.last -image $image_type -pady 2 -padx 3
      .main.text tag bind $user_login <Enter> \
          ".main.text tag conf $user_login -under true;.main.text conf -cursor hand2"
      .main.text tag bind $user_login <Leave> \
          ".main.text tag conf $user_login -under false;.main.text conf -cursor left_ptr"
      .main.text tag bind $user_login <Double-Button-1> \
          "cmsn_chat_user $user_login"
      .main.text tag bind $user_login <Button-3> "show_umenu $user_login %X %Y"
   }

   .main.text configure -state disabled
}

proc block_user {user_login} {
   write_ns_sock REM "AL ${user_login}"
   write_ns_sock ADD "BL ${user_login} ${user_login}"
}

proc unblock_user {user_login} {
   write_ns_sock REM "BL ${user_login}"
   write_ns_sock LST "RL"
}

proc delete_user {user_login} {
   write_ns_sock REM "FL ${user_login}"
   write_ns_sock REM "AL ${user_login}"
}

proc show_umenu {user_login x y} {
   global list_bl

   set blocked [lsearch $list_bl "${user_login} *"]
   .user_menu delete 0 end
   .user_menu add command -label "Instant Message" \
      -command "cmsn_chat_user ${user_login}"
   .user_menu add separator
   if {$blocked == -1} {
      .user_menu add command -label "Block" -command  "block_user ${user_login}"
   } else {
      .user_menu add command -label "Unblock" \
         -command  "unblock_user ${user_login}"
   }
   .user_menu add command -label "Delete" -command "delete_user ${user_login}"

   tk_popup .user_menu $x $y
}

proc login_ok {} {
   global config password

   set config(login) [.login.c.signin get]
   set password [.login.c.password get]
   grab release .login
   destroy .login
   cmsn_ns_connect
}

proc cmsn_draw_msgwin {} {
   global images_folder sb_num sb_list

   incr sb_num
   set name "sb$sb_num"
   set win_name "msg_[string tolower ${name}]"

   lappend sb_list "$name"
   sb set $name name $name
   sb set $name sock ""
   sb set $name data [list]
   sb set $name users [list]
   sb set $name typers [list]
   sb set $name title "Instant Message"

   toplevel .${win_name}
   wm title .${win_name} "Instant Message"
   wm group .${win_name} ""

   menu .${win_name}.menu -tearoff 0 -type menubar -background #C0C0C0 \
      -borderwidth 0 -activeborderwidth -0
   .${win_name}.menu add cascade -label CCMSN -menu .${win_name}.menu.msn
   .${win_name}.menu add cascade -label Invite -menu .${win_name}.menu.invite \
      -state disabled

   menu .${win_name}.menu.msn -tearoff 0 -type normal -background #C0C0C0
   .${win_name}.menu.msn add command -label "Close this chat" \
      -command "destroy .${win_name}"

   menu .${win_name}.menu.invite -tearoff 0 -type normal -background #C0C0C0
   .${win_name}.menu.invite add separator
   .${win_name}.menu.invite add command -label "Other..." -state disabled
#   bind .${win_name}.menu <<MenuSelect>> "cmsn_msgwin_umenu $name"
   bind .${win_name}.menu <Enter> "cmsn_msgwin_umenu $name"

   .${win_name} conf -menu .${win_name}.menu

   frame .${win_name}.top
   text .${win_name}.top.text -background #C0C0C0 -borderwidth 0 -width 30 \
      -height 1 -wrap word -yscrollcommand ".${win_name}.top.ys set"
   scrollbar .${win_name}.top.ys -command ".${win_name}.top.text yview" \
      -background #C0C0C0
   text .${win_name}.text -background white -width 50 -height 15 -wrap word \
      -yscrollcommand ".${win_name}.ys set"
   scrollbar .${win_name}.ys -command ".${win_name}.text yview" \
      -background #C0C0C0
   text .${win_name}.status -background #C0C0C0 -width 30 -height 1 -wrap none
   frame .${win_name}.in
   text .${win_name}.in.input -background white -width 25 -height 3 -wrap word
   button .${win_name}.in.send -background #C0C0C0 -text Send -width 5 \
      -command "sb_enter $name .${win_name}.in.input"

   pack .${win_name}.top -side top -fill x
   pack .${win_name}.status -side bottom -fill x
   pack .${win_name}.in -side bottom -fill x
   pack .${win_name}.ys -side right -fill y
   pack .${win_name}.text -expand true -fill both

   pack .${win_name}.top.text -side left -expand true -fill x
   pack .${win_name}.in.send -side right -fill y
   pack .${win_name}.in.input -side left -expand true -fill x

   .${win_name}.top.text configure -state disabled
   .${win_name}.text configure -state disabled
   .${win_name}.status configure -state disabled
   .${win_name}.in.send configure -state disabled
   .${win_name}.in.input configure -state disabled

   .${win_name}.text tag configure green -foreground darkgreen -background white
   .${win_name}.text tag configure red -foreground red -background white
   .${win_name}.text tag configure white -foreground white -background black

   bind .${win_name}.in.input <Return> "sb_enter $name %W; break"
   bind .${win_name}.in.input <Alt-s> "sb_enter $name %W; break"
   bind .${win_name}.in.input <Tab> "focus .${win_name}.in.send; break"
   bind .${win_name}.in.send <Return> \
      "sb_enter $name .${win_name}.in.input; break"
   bind .${win_name}.in.input <Control-Return> {%W insert end "\n"; break}
   bind .${win_name} <Destroy> "cmsn_destroyed_msgwin $name %W"

#   pack .${win_name}.top.ys -side right -fill y
#   pack forget .${win_name}.top.ys

   return ${name}

}

proc cmsn_destroyed_msgwin {name winpath} {
   global sb_list ${name}_info config
   set win_name "msg_[string tolower ${name}]"

   if {"${winpath}" != ".${win_name}"} {
      return 0
   }

   set idx [lsearch -exact $sb_list $name]
   if {$idx == -1} {
      status_log "tried to destroy unknown SB $name\n" white
      return 0
   }

   set sb_list [lreplace $sb_list $idx $idx]
   if {[sb get $name stat] != "d"} {
      puts [sb get $name sock] "OUT"
      close [sb get $name sock]
   }
   if {$config(keep_logs) && [sb exists $name log_fcid]} {		;# LOGS!
      close [sb get $name log_fcid]
   }
   unset ${name}_info

}

proc cmsn_show_typers {name} {
   global list_users
   set win_name "msg_[string tolower ${name}]"
   .${win_name}.status configure -state normal
   .${win_name}.status delete 0.0 end

   set num_typers [sb length $name typers]
   if {$num_typers == 0} {
      #TODO last msg received
      set statusmsg ""
   } else {
      if {$num_typers == 1} {
         set is_are "is"
      } else {
         set is_are "are"
      }
      upvar #0 [sb name $name typers] typers_list
      set statusmsg ""
      foreach login $typers_list {
         set idx [sb search $name users "$login *"]
         set usrinfo [sb index $name users $idx]
         set user_name [lindex $usrinfo 1]
         set statusmsg "${statusmsg}${user_name}, "
      }
      set statusmsg [string replace $statusmsg end-1 end " $is_are typing a message."]
   }

   .${win_name}.status insert end $statusmsg
   .${win_name}.status configure -state disabled
}

proc cmsn_msgwin_title {name} {
   upvar #0 [sb name $name users] users_list
   set win_name "msg_[string tolower ${name}]"

   if {[llength $users_list]} {
      set title ""
      set topmsg "To: "
      foreach usrinfo $users_list {
         set user_login [lindex $usrinfo 0]
         set user_name [lindex $usrinfo 1]
         set title "${title}${user_name}, "
         set topmsg "${topmsg}${user_name} <${user_login}>, "
      }
      set title [string replace $title end-1 end " - Instant Message"]
      set topmsg [string replace $topmsg end-1 end]
   } else {
      set title "Instant Message"
      set topmsg "No other users are connected to this session!"
   }
   wm title .${win_name} ${title}
   sb set $name title ${title}

   cmsn_msgwin_top $name $topmsg

}

proc cmsn_msgwin_flicker {name count} {
   set win_name "msg_[string tolower ${name}]"

   incr count -1
   catch {
      if {[expr $count % 2]} {
         wm title .${win_name} "New Message"
      } else {
         wm title .${win_name} [sb get $name title]
      }
   }

   if {$count > 0} {
      after 500 cmsn_msgwin_flicker $name $count
   }
   
}

proc cmsn_msgwin_top {name txt} {
   set win_name "msg_[string tolower ${name}]"

   .${win_name}.top.text configure -state normal
   .${win_name}.top.text delete 0.0 end
   .${win_name}.top.text insert end $txt
   .${win_name}.top.text configure -state disabled
}

proc cmsn_win_write {name txt {colour ""}} {
   global emotions config

   set win_name "msg_[string tolower ${name}]"

   .${win_name}.text configure -state normal

   .${win_name}.text mark set new_text_start end
   .${win_name}.text insert end "$txt" $colour

   if {$config(keep_logs) && [sb exists $name log_fcid]} {	;# LOGS!
      puts -nonewline [sb get $name log_fcid] $txt
   }
   foreach emotion $emotions {
      set symbol [lindex $emotion 0]
      set file [lindex $emotion 1]
      set chars [string length $symbol]
      while {[set pos [.${win_name}.text search -exact -nocase \
                              $symbol new_text_start end]] != ""} {
         set posyx [split $pos "."]
         set endpos "[lindex $posyx 0].[expr [lindex $posyx 1] + $chars]"
         .${win_name}.text delete $pos $endpos

         .${win_name}.text image create $pos -image $file -pady 1 -padx 1

      }
   }

   .${win_name}.text yview moveto 1.0
   .${win_name}.text configure -state disabled

}

proc cmsn_draw_addcontact {} {
   global addcontact_request

   if {[info exists addcontact_request]} {
      raise .addcontact
      return 0
   }

   set addcontact_request true
   toplevel .addcontact -width 400 -height 150 
   bind .addcontact <Destroy> {
      if {"%W" == ".addcontact"} {
         unset addcontact_request
      }
   }

   wm geometry .addcontact -0+100
   wm title .addcontact "Add a Contact - Compu's Messenger"
   wm transient .addcontact .
   canvas .addcontact.c -width 400 -height 150 -bg #C0C0C0
   pack .addcontact.c -expand true -fill both

   entry .addcontact.c.email -width 40 -bg #FFFFFF -bd 1 \
      -font {Courier -14 bold}
   button .addcontact.c.next -text "Next >" -bg #C0C0C0 -command addcontact_next
   button .addcontact.c.cancel -text "Cancel" -bg #C0C0C0 \
      -command "grab release .addcontact;destroy .addcontact"

   .addcontact.c create text 5 10 -font {Helvetica 12 bold} -anchor nw \
	-text "Please enter the contact's e-mail address:"
   .addcontact.c create text 70 60 -font {Helvetica 10} -anchor ne \
	-text "Examples: "
   .addcontact.c create text 70 60 -font {Helvetica 10} -anchor nw \
	-text "gudidu@hotmail.com\nmyname@msn.com\nexample@passport.com"
   .addcontact.c create window 5 35 -window .addcontact.c.email -anchor nw
   .addcontact.c create window 195 120 -window .addcontact.c.next -anchor ne
   .addcontact.c create window 205 120 -window .addcontact.c.cancel -anchor nw

   bind .addcontact.c.email <Return> "addcontact_next"

   tkwait visibility .addcontact
   grab set .addcontact
}

proc addcontact_next {} {
   set tmp_email [.addcontact.c.email get]
   write_ns_sock "ADD" "FL $tmp_email $tmp_email"
   grab release .addcontact
   destroy .addcontact
}

proc cmsn_proxy {} {
   global configuring_proxy config

   if {[info exists configuring_proxy]} {
      raise .proxy_conf
      return 0
   }

   set configuring_proxy true
   toplevel .proxy_conf -width 400 -height 150 
   bind .proxy_conf <Destroy> {
      if {"%W" == ".proxy_conf"} {
         unset configuring_proxy
      }
   }
   wm geometry .proxy_conf -0+100
   wm title .proxy_conf "Configure proxy - Compu's Messenger"
   wm transient .proxy_conf .
   canvas .proxy_conf.c -width 400 -height 150 -bg #C0C0C0
   pack .proxy_conf.c -expand true -fill both

   entry .proxy_conf.c.server -width 20 -bg #FFFFFF -bd 1 \
      -font {Courier -14 bold}
   entry .proxy_conf.c.port -width 5 -bg #FFFFFF -bd 1 \
      -font {Courier -14 bold}
   button .proxy_conf.c.ok -text "OK" -command proxy_conf_ok
   button .proxy_conf.c.cancel -text "Cancel" \
      -command "grab release .proxy_conf;destroy .proxy_conf"

   .proxy_conf.c create text 200 15 -font {Helvetica 16 bold} -anchor center \
	-text "Configure HTTP Proxy support"
   .proxy_conf.c create text 133 35 -font {Helvetica 12 bold} -anchor ne \
	-text "Server: "
   .proxy_conf.c create text 133 60 -font {Helvetica 12 bold} -anchor ne \
	-text "Port: "
   .proxy_conf.c create text 133 82 -font {Helvetica 10} -anchor nw \
	-text "Leave empty to connect directly to server"
   .proxy_conf.c create window 133 35 -window .proxy_conf.c.server -anchor nw
   .proxy_conf.c create window 133 60 -window .proxy_conf.c.port -anchor nw
   .proxy_conf.c create window 195 120 -window .proxy_conf.c.ok -anchor ne
   .proxy_conf.c create window 205 120 -window .proxy_conf.c.cancel -anchor nw

   set proxy_data [split $config(proxy) ":"]
   .proxy_conf.c.server insert 0 [lindex $proxy_data 0]
   .proxy_conf.c.port insert 0 [lindex $proxy_data 1]

   tkwait visibility .proxy_conf
   grab set .proxy_conf
}

proc proxy_conf_ok {} {
   global config

   set config(proxy) [join [list [.proxy_conf.c.server get] [.proxy_conf.c.port get]] ":"]
   grab release .proxy_conf
   destroy .proxy_conf
}

proc newcontact {new_login new_name} {
   global newc_allow_block newc_add_to_list newc_exit list_fl

   set newc_allow_block "allow"
   set newc_exit ""

   if {[lsearch $list_fl "$new_login *"] != -1} {
      set add_stat "disabled"
      set newc_add_to_list 0
   } else {
      set add_stat "normal"
      set newc_add_to_list 1
   }
   toplevel .newc
 
   wm geometry .newc -0+100
   wm title .newc "$new_name - Compu's Messenger"
   wm transient .newc .
   canvas .newc.c -width 500 -height 150 -bg #C0C0C0
   pack .newc.c -expand true -fill both
 
   button .newc.c.ok -text OK -bg #C0C0C0 \
      -command "set newc_exit ok;grab release .newc;destroy .newc"
   button .newc.c.cancel -text Cancel -bg #C0C0C0 \
      -command "grab release .newc;destroy .newc"

  radiobutton .newc.c.allow -bg #C0C0C0 -variable newc_allow_block \
     -text "Allow this person to see when you are online and contact you" \
     -activebackground #C0C0C0 -highlightthickness 0 \
     -activeforeground #FFFFFF -selectcolor #FFFFFF -value allow
  radiobutton .newc.c.block -bg #C0C0C0 -variable newc_allow_block \
     -text "Block this person from seeing you are online and contacting you" \
     -activebackground #C0C0C0 -highlightthickness 0 \
     -activeforeground #FFFFFF -selectcolor #FFFFFF -value block
   checkbutton .newc.c.add -bg #C0C0C0 -var newc_add_to_list -state $add_stat \
      -text "Add this person to my contact list"  -activebackground #C0C0C0 \
      -highlightthickness 0 -activeforeground #FFFFFF -selectcolor #FFFFFF

 
   .newc.c create text 30 5 -font {Helvetica 12 bold} -anchor nw -justify left \
        -text "$new_name ($new_login) has added you to his/her contact list." \
        -width 460
   .newc.c create text 30 40 -font {Helvetica 12 bold} -anchor nw \
        -text "Do you want to:"
   .newc.c create window 40 58 -window .newc.c.allow -anchor nw
   .newc.c create window 40 76 -window .newc.c.block -anchor nw
   .newc.c create window 30 94 -window .newc.c.add -anchor nw
   .newc.c create window 245 120 -window .newc.c.ok -anchor ne
   .newc.c create window 255 120 -window .newc.c.cancel -anchor nw

   tkwait visibility .newc
   grab set .newc
}

proc cmsn_draw_notify {} {
   global notify_id

   toplevel .notify -width 150 -height 100
   wm title .notify "CCMSN notify"
   wm overrideredirect .notify 1
   wm geometry .notify -10-60
   wm transient .notify .
   wm state .notify withdraw

   canvas .notify.c -bg #FFFFFF -width 150 -height 100 \
      -relief ridge -borderwidth 2
   pack .notify.c

   set notify_id [.notify.c create text 75 50 -font {Helvetica 10} \
      -justify center]
}

proc cmsn_update_notify {} {
   global list_notify notify_id

   set notify_text ""
   set cursec [clock seconds]
   set items [expr [llength $list_notify] -1]
   for {set idx $items} {$idx >= 0} {incr idx -1} {
      set notify_item [lindex $list_notify $idx]
      set msg [lindex $notify_item 0]
      set msgsec [lindex $notify_item 1]
      if {$msgsec < $cursec} {
         set list_notify [lreplace $list_notify $idx $idx]
      } else {
         set notify_text "\n\n$msg${notify_text}"
      }
   }

   set notify_text [string range ${notify_text} 2 end]
   .notify.c dchars $notify_id 0 end
   .notify.c insert $notify_id 0 $notify_text

   if {[string length $notify_text] > 0} {
      wm state .notify normal
   } else {
      wm state .notify withdraw
   }

   wm geometry .notify -10-60
   raise .notify
   after 1000 cmsn_update_notify
}

proc cmsn_notify_add {msg {sec 10}} {
   global list_notify

   lappend list_notify [list $msg [expr [clock seconds] + $sec]]
}

proc cmsn_change_name {} {
   global change_name

   if {[info exists change_name]} {
      raise .change_name
      return 0
   }

   set change_name true
   toplevel .change_name -width 400 -height 150 
   bind .change_name <Destroy> {
      if {"%W" == ".change_name"} {
         unset change_name
      }
   }
   wm geometry .change_name -0+100
   wm title .change_name "Change My Display Name - Compu's Messenger"
   canvas .change_name.c -width 400 -height 150 -bg #C0C0C0
   pack .change_name.c -expand true -fill both

   entry .change_name.c.name -width 40 -bg #FFFFFF -bd 1 \
      -font {Courier -14 bold}
   button .change_name.c.ok -text "OK" -bg #C0C0C0 -command change_name_ok
   button .change_name.c.cancel -text "Cancel" -bg #C0C0C0 \
      -command "destroy .change_name"

   .change_name.c create text 5 10 -font {Helvetica 12 bold} -anchor nw \
	-text "Enter your name as you want other users to see it"
   .change_name.c create window 5 35 -window .change_name.c.name -anchor nw
   .change_name.c create window 195 120 -window .change_name.c.ok -anchor ne
   .change_name.c create window 205 120 -window .change_name.c.cancel -anchor nw

   bind .change_name.c.name <Return> "change_name_ok"
}

proc change_name_ok {} {
   global config

   set new_name [.change_name.c.name get]
   if {$new_name != ""} {
      write_ns_sock "REA" "$config(login) [urlencode $new_name]"
   }
   destroy .change_name
}
#=======================================================================

proc cmsn_msgwin_umenu {name} {
   global list_users
   set win_name "msg_[string tolower ${name}]"

   .${win_name}.menu.invite delete 0 end
   .${win_name}.menu.invite add separator
   .${win_name}.menu.invite add command -label "Other..." -state disabled

   foreach user_info $list_users {
      set user_login [lindex $user_info 0]
      set user_state_no [lindex $user_info 2]
      if {($user_state_no < 7) && 
          ([sb search $name users "$user_login *"] == -1)} {
         set user_name [lindex $user_info 1]
	 .${win_name}.menu.invite insert 0 command \
            -command "cmsn_invite_user $name $user_login;puts $user_login" \
	    -label "$user_name <$user_login>"
      }
   }
}

proc cmsn_logout {} {
   puts -nonewline [sb get ns sock] "OUT\r\n"
   status_log "Logging out!!\n"
}

proc change_my_status {new_status} {
   write_ns_sock "CHG" $new_status
   status_log "Changing status to $new_status\n" red
}

proc cmsn_sb_sessionclosed {sbn} {
   set win_name "msg_[string tolower ${sbn}]"

   status_log "$sbn: SESSION CLOSED\n" red
   sb set $sbn stat "d"
   .${win_name}.menu entryconfigure 1 -state disabled
   set items [expr [sb length $sbn users] -1]
   sb set $sbn last_user [sb index $sbn users 0]
   for {set idx $items} {$idx >= 0} {incr idx -1} {
      set user_info [sb index $sbn users $idx]
      sb ldel $sbn users $idx
      .${win_name}.in.send configure -state disabled
      cmsn_win_write $sbn "[lindex $user_info 0] leaves chat!\n" green
      cmsn_msgwin_title $sbn
      bind .${win_name}.in.input <Key> "cmsn_reconnect ${sbn}"
      bind .${win_name}.in.input <Return> "cmsn_reconnect ${sbn}; break"
   }
}

proc read_sb_sock {sbn} {

   set sb_sock [sb get $sbn sock]
   if {[eof $sb_sock]} {
      close $sb_sock
      cmsn_sb_sessionclosed $sbn
   } else {
      gets $sb_sock tmp_data
      sb append $sbn data $tmp_data
      set log [string map {\r ""} $tmp_data]
      #status_log "$sbn: RECV: $log\n" green
      if {[string range $tmp_data 0 2] == "MSG"} {
         set recv [split $tmp_data]
	 fconfigure $sb_sock -blocking 1
	 set msg_data [read $sb_sock [lindex $recv 3]]
	 fconfigure $sb_sock -blocking 0
	 sb append $sbn data $msg_data
      }
   }

}
proc write_sb_sock {sbn cmd param {handler ""}} {
   global trid
   incr trid

   puts [sb get $sbn sock] "$cmd $trid $param\r"
   status_log "$sbn: SEND: $cmd $trid $param\n" red
   if {$handler != ""} {
      global list_cmdhnd
      lappend list_cmdhnd [list $trid $handler]
   }
}

proc sb {do sbn var {value ""}} {
   global ${sbn}_info
   set sb_tmp "${sbn}_info(${var})"
   upvar #0 $sb_tmp sb_data

   switch $do {
      name {
	 return $sb_tmp
      }
      set {
         set sb_data $value
	 return 0
      }
      get {
	 return $sb_data
      }
      append {
         lappend sb_data $value
      }
      index {
         return [lindex $sb_data $value]
      }
      ldel {
         set sb_data [lreplace $sb_data $value $value]
      }
      length {
         return [llength $sb_data]
      }
      search {
         return [lsearch $sb_data $value]
      }
      exists {
         return [info exists $sb_tmp]
      }
      unset {
         unset $sb_tmp
      }
   }

}

proc read_ns_sock {} {
   global ns_data ns_stat

   set ns_sock [sb get ns sock]
   if {[eof $ns_sock]} {
      close $ns_sock
      sb set ns stat "d"
      status_log "Closing NS socket!\n" red
      cmsn_draw_offline
   } else {
      gets $ns_sock tmp_data
      sb append ns data $tmp_data
      set log [string map {\r ""} $tmp_data]
      status_log "RECV: $log\n" green

      if {[string range $tmp_data 0 2] == "MSG"} {
         set recv [split $tmp_data]
	 fconfigure $ns_sock -blocking 1
	 set msg_data [read $ns_sock [lindex $recv 3]]
	 fconfigure $ns_sock -blocking 0
         sb append ns data $msg_data
      }
   }

}

proc write_ns_sock {cmd param {handler ""}} {
   global trid
   incr trid

   puts -nonewline [sb get ns sock] "$cmd $trid $param\r\n"
   status_log "SEND: $cmd $trid $param\n" red
   if {$handler != ""} {
      global list_cmdhnd
      lappend list_cmdhnd [list $trid $handler]
   }

}

proc proc_sb {} {
   global sb_list

   foreach sbn $sb_list {
      while {[sb length $sbn data]} {
         set item [split [sb index $sbn data 0]]

         set result [cmsn_sb_handler $sbn $item]
         if {$result == 0} {
	    sb ldel $sbn data 0
         } else {
            status_log "problem processing SB data!!\n" red
	    return 0
         } ;# if

      } ;# while
   } ;# foreach

   after 250 proc_sb
}

proc proc_ns {} {

   while {[sb length ns data]} {

      set item [split [sb index ns data 0]]

      set result [cmsn_ns_handler $item]
      if {$result == 0} {
	 sb ldel ns data 0
      } else {
         status_log "problem processing NS data!!\n" red
	 return 0
      }

   }

   after 100 proc_ns
}

proc cmsn_msg_parse {msg hname bname} {
   upvar $hname headers
   upvar $bname body

   set head_len [string first "\r\n\r\n" $msg]
   set head [string range $msg 0 [expr $head_len - 1]]
   set body [string range $msg [expr $head_len + 4] [string length $msg]]

   set head [string map {"\r" ""} $head]
   set head_lines [split $head "\n"]
   foreach line $head_lines {
      set colpos [string first ":" $line]
      set attribute [string tolower [string range $line 0 [expr $colpos-1]]]
      set value [string range $line [expr $colpos+2] [string length $line]]
      array set headers [list $attribute $value]
   }

}

proc cmsn_sb_msg {sb_name recv} {
   set msg [sb index $sb_name data 1]
   sb ldel $sb_name data 1
   array set headers {}
   set body ""
   cmsn_msg_parse $msg headers body

   set content [lindex [array get headers content-type] 1]
   set timestamp [clock format [clock seconds] -format %H:%M]

   if {[string range $content 0 9] == "text/plain"} {
      cmsn_win_write $sb_name "\[$timestamp\] [urldecode [lindex $recv 2]] says:\n" green
      cmsn_win_write $sb_name "$body\n"
      set idx [sb search $sb_name typers [lindex $recv 1]]
      sb ldel $sb_name typers $idx
      cmsn_show_typers $sb_name
      cmsn_msgwin_flicker $sb_name 20
   } elseif {[string range $content 0 19] == "text/x-msmsgscontrol"} {
#      status_log "$msg\n" white
      set typer [array get headers typinguser]
      if {[llength $typer]} {
         set typer [lindex $typer 1]
	 set idx [sb search $sb_name typers "$typer"]
	 if {$idx == -1} {
            sb append $sb_name typers $typer
	 } else {
            sb ldel $sb_name typers $idx
         }
         cmsn_show_typers $sb_name
      }

   } else {
      status_log "=== UNKNOWN MSG ===\n$msg\n" white
   }

}

proc cmsn_update_users {sb_name recv} {
   global config

   switch [lindex $recv 0] {
      BYE { if {[sb get $sb_name stat] != "d"} {
         cmsn_win_write $sb_name "[lindex $recv 1] leaves chat!\n" green
	 set leaves [sb search $sb_name users "[lindex $recv 1] *"]
	 sb ldel $sb_name users $leaves
	 sb set $sb_name last_user [lindex $recv 1]
      } }
      IRO {
         sb set $sb_name stat "o"
	 set usr_login [lindex $recv 4]
	 set usr_name [urldecode [lindex $recv 5]]
	 sb append $sb_name users [list $usr_login $usr_name]
         cmsn_win_write $sb_name "$usr_name ($usr_login) joins chat\n" green
      }
      JOI {
         sb set $sb_name stat "o"
	 set usr_login [lindex $recv 1]
	 set usr_name [urldecode [lindex $recv 2]]
	 sb append $sb_name users [list $usr_login $usr_name]
         cmsn_win_write $sb_name "$usr_name ($usr_login) joins chat\n" green
      }
   }

   if {[sb exists $sb_name log_fcid]} {
      close [sb get $sb_name log_fcid]
      sb unset $sb_name log_fcid
   }
   if {$config(keep_logs) && [sb length $sb_name users]} {	;# LOGS!
      global log_dir
      upvar #0 [sb name $sb_name users] tmp_users_list
      set users_list [lsort $tmp_users_list]
      set file_name ""
      foreach usrinfo $users_list {
         set user_email [split [lindex $usrinfo 0] "@"]
	 set user_login [lindex $user_email 0]
         set file_name "${file_name}-${user_login}"
      }
      set file_name [string range ${file_name} 1 end]
      sb set $sb_name log_fcid [open "${log_dir}/${file_name}" a+]
   }

   cmsn_msgwin_title $sb_name
   set win_name "msg_[string tolower ${sb_name}]"
   if {[sb length $sb_name users] > 0} {
      .${win_name}.in.input configure -state normal
      .${win_name}.in.send configure -state normal
      .${win_name}.menu entryconfigure 1 -state normal
      bind .${win_name}.in.input <Key> ""
      bind .${win_name}.in.input <Return> "sb_enter $sb_name %W; break"
   } else {
      if {[sb get $sb_name stat] != "d"} { sb set $sb_name stat "n" }
      .${win_name}.in.send configure -state disabled
      bind .${win_name}.in.input <Key> "cmsn_reconnect ${sb_name}"
      bind .${win_name}.in.input <Return> "cmsn_reconnect ${sb_name}; break"
   }
}

proc cmsn_sb_handler {sb_name item} {
   global list_cmdhnd

   set ret_trid [lindex $item 1]
   set idx [lsearch $list_cmdhnd "$ret_trid *"]
   if {$idx != -1} {		;# Command has a handler associated!
      eval "[lindex [lindex $list_cmdhnd $idx] 1] \"$item\""
      status_log "evaluating handler for $ret_trid\n"
      return 0
   } else {
   switch [lindex $item 0] {
      MSG {
	 cmsn_sb_msg $sb_name $item
	 return 0
      }
      BYE -
      JOI -
      IRO {
	 cmsn_update_users $sb_name $item
	 return 0
      }
      CAL {
	 return 0
      }
      ANS {
         status_log "$sb_name: [join $item]\n" green
	 return 0
      }
      default {
         status_log "$sb_name: UNKNOWN SB input!! --> [join $item]\n" red
	 return 0
      }
   }
   }
}

proc cmsn_invite_user {name user} {
   status_log "$name: Inviting  $user\n" green
   write_sb_sock $name "CAL" $user
}

proc cmsn_chat_user {user} {
   set name [cmsn_draw_msgwin]
   sb set $name stat "r"
   sb set $name invite $user

   status_log "$name: CHAT1 Chatting $user\n" green
   write_ns_sock "XFR" "SB" "cmsn_open_sb $name"
   cmsn_msgwin_top $name "Requesting a chat session..."
}

proc cmsn_rng {recv} {
   global config

   set sbn [cmsn_draw_msgwin]
   sb set $sbn serv [split [lindex $recv 2] ":"]
   sb set $sbn connected "cmsn_conn_ans $sbn"
   sb set $sbn readable "read_sb_sock $sbn"
   sb set $sbn auth_cmd "ANS"
   sb set $sbn auth_param "$config(login) [lindex $recv 4] [lindex $recv 1]"

   status_log "$sbn: ANS1 answering [lindex $recv 5]\n" green
   cmsn_msgwin_top $sbn "Answering chat session from [lindex $recv 5]..."
   cmsn_socket $sbn
   return 0
}

proc cmsn_open_sb {sbn recv} {
   global config

   if {[lindex $recv 4] != "CKI"} {
      status_log "$sbn: Unknown SP requested!\n" red
      return 1
   }
   sb set $sbn serv [split [lindex $recv 3] ":"]
   sb set $sbn connected "cmsn_conn_sb $sbn"
   sb set $sbn readable "read_sb_sock $sbn"
   sb set $sbn auth_cmd "USR"
   sb set $sbn auth_param "$config(login) [lindex $recv 5]"

   status_log "$sbn: CHAT2: connecting to Switch Board [lindex $recv 3]\n"
   cmsn_msgwin_top $sbn "Connecting to Switch Board..."
   cmsn_socket $sbn
}

proc cmsn_conn_sb {name} {
   fileevent [sb get $name sock] writable {}
   sb set $name stat "a"
   set cmd [sb get $name auth_cmd]; set param [sb get $name auth_param]
   write_sb_sock $name $cmd $param "cmsn_connected_sb $name"
   cmsn_msgwin_top $name "Authenticating..."
}

proc cmsn_conn_ans {name} {
   fileevent [sb get $name sock] writable {}
   sb set $name stat "a"
   set cmd [sb get $name auth_cmd]; set param [sb get $name auth_param]
   write_sb_sock $name $cmd $param
   cmsn_msgwin_top $name "Authenticating..."
}

proc cmsn_connected_sb {name recv} {
   sb set $name stat "i"
   if {[sb exists $name invite]} {
      cmsn_invite_user $name [sb get $name invite]
      cmsn_msgwin_top $name "Waiting for [sb get $name invite] to join chat..."
   }
}

proc cmsn_reconnect {name} {
   if {[sb get $name stat] == "n"} {
      sb set $name stat "i"
      cmsn_invite_user $name [lindex [sb get $name last_user] 0]
      cmsn_msgwin_top $name \
         "Waiting for [sb get $name last_user] to rejoin chat..."
   } elseif {[sb get $name stat] == "d"} {
      sb set $name stat "rc"
      sb set $name invite [lindex [sb get $name last_user] 0]
      write_ns_sock "XFR" "SB" "cmsn_open_sb $name"
      cmsn_msgwin_top $name "Reconnecting to server..."
   }
}

proc cmsn_ns_handler {item} {
   global list_cmdhnd

   set ret_trid [lindex $item 1]
   set idx [lsearch $list_cmdhnd "$ret_trid *"]
   if {$idx != -1} {		;# Command has a handler associated!
      eval "[lindex [lindex $list_cmdhnd $idx] 1] \"$item\""
      status_log "evaluating handler for $ret_trid\n"
      return 0
   } else {
   switch [lindex $item 0] {
      VER -
      INF -
      USR {
	 return [cmsn_auth $item]
      }
      XFR {
	 if {[lindex $item 2] == "NS"} {
	    set tmp_ns [split [lindex $item 3] ":"]
            sb set ns serv $tmp_ns
            status_log "got a NS transfer!\n"
            status_log "reconnecting to [lindex $tmp_ns 0]\n"
            cmsn_ns_connect
            return 0
	 } else {
            status_log "got an unknown transfer!!\n" red
            return 0
	 }
      }
      RNG {
         return [cmsn_rng $item]
      }
      REA {
         global user_info
         set user_info $item
	 cmsn_draw_online
	 return 0
      }
      ADD -
      LST {
         cmsn_listupdate $item
         return 0
      }
      REM {
         cmsn_listdel $item
         return 0
      }
      MSG {
         cmsn_ns_msg $item
	 return 0
      }
      FLN -
      ILN -
      NLN {
         cmsn_change_state $item
	 return 0
      }
      CHG {
	 global user_stat
	 set user_stat [lindex $item 2]
	 cmsn_draw_online
	 return 0
      }
      GTC -
      BLP -
      SYN {
	 return 0
      }
      default {
         status_log "RECV: [join $item]\n" green
         status_log "Got unknown NS input!! --> [lindex $item 0]\n" red
	 return 0
      }
   }
   }

}

proc cmsn_change_state {recv} {
   global list_fl list_users

   if {[lindex $recv 0] == "FLN"} {
      set user [lindex $recv 1]
      set user_name ""
      set substate "FLN"
   } else {
      if {[lindex $recv 0] == "ILN"} {
         set user [lindex $recv 3]
         set user_name [urldecode [lindex $recv 4]]
         set substate [lindex $recv 2]
      } else {
         set user [lindex $recv 2]
         set user_name [urldecode [lindex $recv 3]]
         set substate [lindex $recv 1]
      }
   }

   set idx [lsearch $list_users "$user *"]
   if {$idx != -1} {
      global list_users list_states

      set user_data [lindex $list_users $idx]
      if {$user_name == ""} {
         set user_name [urldecode [lindex $user_data 1]]
      }

      if {[lindex $user_data 2] < 7} {		;# User was online before
         .main_menu.msg delete "[urldecode [lindex $user_data 1]] <$user>"
      } elseif {[lindex $recv 0] == "NLN"} {	;# User was offline, now online
            cmsn_notify_add "$user_name\nhas just signed in."
      }

      if {$substate != "FLN"} {
         .main_menu.msg insert 0 command -label "$user_name <$user>" \
            -command "cmsn_chat_user $user"
      }

      set state_no [lsearch $list_states "$substate *"]

      set list_users [lreplace $list_users $idx $idx [list $user $user_name $state_no]]
      set list_users [lsort -decreasing -index 2 [lsort -decreasing -index 1 $list_users]]

      cmsn_draw_online
   } else {
      puts "PANIC!"
   }

}

proc cmsn_ns_msg {recv} {
   set msg [sb index ns data 1]
   sb ldel ns data 1
   status_log "[lindex $recv 2] ([lindex $recv 1]) says:\n" green
   status_log "$msg\n" green
   status_log "=========================================\n" green
}

proc list_users_refresh {} {
   global list_fl list_users list_states

   set list_users_new [list]
   set fln [lsearch $list_states "FLN *"]

   foreach user $list_fl {
      set user_login [lindex $user 0]
      set user_name [lindex $user 1]
      set idx [lsearch $list_users "$user_login *"]
      if {$idx != -1} {
         lappend list_users_new [lindex $list_users $idx]
      } else {
         lappend list_users_new [list $user_login $user_name $fln]
      }
   }

   set list_users [lsort -decreasing -index 2 [lsort -decreasing -index 1 $list_users_new]]
   cmsn_draw_online

}

proc lists_compare {} {
   global list_fl list_al list_bl list_rl
   global newc_allow_block newc_add_to_list newc_exit
   set list_albl [lsort [concat $list_al $list_bl]]
   set list_rl [lsort $list_rl]

   foreach x $list_rl {
      if {[lsearch $list_albl "[lindex $x 0] *"] == -1} {
         status_log "$x in your RL list but not in your AL/BL list!\n" white
	 newcontact [lindex $x 0] [lindex $x 1]
         tkwait window .newc 
         if {$newc_exit == "ok"} {
	    if {$newc_allow_block == "allow"} {
	       write_ns_sock "ADD" "AL [lindex $x 0] [urlencode [lindex $x 1]]"
	    } else {
	       write_ns_sock "ADD" "BL [lindex $x 0] [urlencode [lindex $x 1]]"
	    }
	    if {$newc_add_to_list} {
	       write_ns_sock "ADD" "FL [lindex $x 0] [urlencode [lindex $x 1]]"
	    }
	 } ;# if clicked on OK!
      } ;# NOT in AL/BL
   }
}

proc cmsn_listupdate {recv} {
   global list_fl list_al list_bl list_rl

   set list_name "list_[string tolower [lindex $recv 2]]"

   if {([lindex $recv 4] <= 1) && ([lindex $recv 0] == "LST")} {
      set $list_name [list]
      status_log "clearing $list_name\n"
   }

   if {[lindex $recv 0] == "ADD"} {		;# FIX: guess I should really
      set recv [linsert $recv 4 "1" "1"]	;# get it out of here!!
   }

   if {[lindex $recv 4] != 0} {
      set contact_info ""
      set user [lindex $recv 6]
      lappend contact_info $user
      lappend contact_info [urldecode [lindex $recv 7]]
      lappend $list_name $contact_info
   }

   if {[lindex $recv 4] == [lindex $recv 5]} {
      lists_compare		;# FIX: hmm, maybe I should not run it always!
      list_users_refresh
   }
}

proc show_list {list_name} {
   upvar #0 $list_name the_list

   status_log "$list_name\n" red
   foreach x $the_list {
      status_log "$x\n"
   }
}

proc cmsn_listdel {recv} {
   write_ns_sock "LST" "[lindex $recv 2]"
}

proc cmsn_auth {{recv ""}} {
   switch [sb get ns stat] {
      c {
         write_ns_sock "VER" "MSNP2"
	 sb set ns stat "v"
	 return 0
      }
      v {
         if {[lindex $recv 0] != "VER"} {
	    status_log "was expecting VER reply but got a [lindex $recv 0]\n" red
	    return 1
	 } elseif {[lsearch -exact $recv "MSNP2"] != -1} {
            write_ns_sock "INF" ""
	    sb set ns stat "i"
	    return 0
	 } else {
	    status_log "could not negotiate protocol!\n" red
	    return 1
	 }
      }
      i {
         if {[lindex $recv 0] != "INF"} {
	    status_log "was expecting INF reply but got a [lindex $recv 0]\n" red
            return 1
         } elseif {[lsearch -exact $recv "MD5"] != -1} {
            global config
            write_ns_sock "USR" "MD5 I $config(login)"
            sb set ns stat "u"
            return 0
         } else {
            status_log "could not negotiate authentication method!\n" red
            return 1
         }
      }
      u {
         if {([lindex $recv 0] != "USR") || \
            ([lindex $recv 2] != "MD5") || \
            ([lindex $recv 3] != "S")} {
            status_log "was expecting USR x MD5 S xxxxx but got something else!\n" red
            return 1
         }
         write_ns_sock "USR" "MD5 S [get_password 'MD5' [lindex $recv 4]]"
         sb set ns stat "us"
         return 0
      }
      us {
         if {[lindex $recv 0] != "USR"} {
            status_log "was expecting USR reply but got a [lindex $recv 0]\n" red
            return 1
         }
         if {[lindex $recv 2] != "OK"} {
            status_log "error authenticating with server!\n" red
            return 1
         }
         global user_info
         set user_info $recv
         sb set ns stat "a"
	 save_config						;# CONFIG
	 write_ns_sock "SYN" "0"
	 write_ns_sock "CHG" "NLN"
         .main_menu entryconfigure 1 -state normal
         .main_menu.msn entryconfigure 1 -state normal
         .main_menu.msn entryconfigure 2 -state normal
         .main_menu.msn entryconfigure 4 -state normal
         .main_menu.msn entryconfigure 6 -state normal
	 return 0
      }
   }

}

proc sb_enter { sbn name } {
   global trid

   set txt [$name get 0.0 end-1c]
   if {[string length $txt] < 1} { return 0 }

   set sock [sb get $sbn sock]
   if {[string index $txt 0] == "/"} {
      set cmd [string range $txt 1 [string length $txt]]
      puts $sock $cmd
   } elseif {[sb length $sbn users]} {
      set txt_send [string map {"\n" "\r\n"} $txt]
      set msg "MIME-Version: 1.0\r\nContent-Type: text/plain\r\n\r\n"
      set msg "$msg$txt_send"
      set msg_len [string length $msg]
      set timestamp [clock format [clock seconds] -format %H:%M]
      incr trid
      puts $sock "MSG $trid U $msg_len"
      puts -nonewline $sock $msg
      cmsn_win_write $sbn "\[$timestamp\] you say:\n" red
      cmsn_win_write $sbn "$txt\n"
   } else {
      status_log "$sbn: trying to send, but no users connected to same SB session\n" white
      return 0
   }
   $name delete 0.0 end
   focus ${name}
}

proc ns_enter {} {
   puts -nonewline [sb get ns sock] "[.status.enter get]\r\n"
   status_log "SEND: [.status.enter get]\n" red
   .status.enter delete 0 end
}

proc cmsn_socket {name} {
   global config

   if {$config(proxy) != ""} {
      set proxy_serv [split $config(proxy) ":"]
      set tmp_serv [lindex $proxy_serv 0]
      set tmp_port [lindex $proxy_serv 1]
      set next "cmsn_proxy_connect $name"
      set readable_handler "cmsn_proxy_read $name"
      sb set $name stat "pw"
   } else {
      set tmp_serv [lindex [sb get $name serv] 0]
      set tmp_port [lindex [sb get $name serv] 1]
      set readable_handler [sb get $name readable]
      set next [sb get $name connected]
      sb set $name stat "cw"
   }

   set sock [socket -async $tmp_serv $tmp_port]
   sb set $name sock $sock
   fconfigure $sock -buffering none -translation {binary binary} -blocking 0
   fileevent $sock readable $readable_handler
   fileevent $sock writable $next
}

proc cmsn_proxy_read {name} {
   global proxy_header

   set sock [sb get $name sock]
   if {[eof $sock]} {
      close $sock
      sb set $name stat "d"
      status_log "PROXY: $name CLOSED\n" red
   } else {
      if {[gets $sock tmp_data] != -1} {
	 global proxy_header
	 set tmp_data [string map {\r ""} $tmp_data]
	 lappend proxy_header $tmp_data
	 status_log "PROXY RECV: $tmp_data\n"
	 if {$tmp_data == ""} {
	    set proxy_status [split [lindex $proxy_header 0]]
	    if {[lindex $proxy_status 1] != "200"} {
	       close $sock
	       sb set $name stat "d"
	       status_log "PROXY CLOSED: [lindex $proxy_header 0]\n"
               if {$name == "ns"} cmsn_draw_offline ;# maybe should be passed
	       return 1
	    }
	    status_log "PROXY ESTABLISHED: running [sb get $name connected]\n"
            fileevent [sb get $name sock] readable [sb get $name readable]
            eval [sb get $name connected]
         }
      }
   }
}

proc cmsn_proxy_connect {name} {
   fileevent [sb get $name sock] writable {}
   sb set $name stat "pc"
   set tmp_data "CONNECT [join [sb get $name serv] ":"] HTTP/1.0"
   status_log "PROXY SEND: $tmp_data\n"
   puts -nonewline [sb get $name sock] "$tmp_data\r\n\r\n"
}

proc cmsn_ns_connected {} {
   fileevent [sb get ns sock] writable {}
   sb set ns stat "c"
   cmsn_auth
}

proc cmsn_sb_connected {name} {
   fileevent [sb get $name sock] writable {}
   sb set $name stat "c"
   write_sb_sock $name [sb get $name auth_cmd] [sb get $name auth_param]
   cmsn_msgwin_top $name "Authenticating..."
}

proc cmsn_ns_connect {} {
   global config

   if {[sb get ns stat] != "d"} {
      fileevent [sb get ns sock] readable {}
      close [sb get ns sock]
   }

   .main_menu.msn entryconfigure 0 -state disabled
   .main_menu.msn entryconfigure 8 -state disabled

   wm title . "Compu's Messenger - $config(login)"
   cmsn_draw_signin

   sb set ns data [list]
   sb set ns connected "cmsn_ns_connected"
   sb set ns readable "read_ns_sock"

   cmsn_socket ns
}

proc get_password {method data} {
   global password

   set pass [::md5::md5 $data$password]
   return $pass

}

proc urldecode {str} {
    # estracted from ncgi - solves users from needing to install extra packages!
    regsub -all {\+} $str { } str
    regsub -all {[][\\\$]} $str {\\&} str
    regsub -all {%([0-9a-fA-F][0-9a-fA-F])} $str {[format %c 0x\1]} str
    return [subst $str]
}

proc urlencode {str} {
   global url_map

   regsub -all \[^a-zA-Z0-9\] $str {$url_map(&)} str
   return [subst -nobackslashes -nocommands $str]
}
###############################################################
create_dir $HOME
create_dir $log_dir

sb set ns name ns
sb set ns sock ""
sb set ns data [list]
sb set ns serv [split $config(start_ns_server) ":"]
sb set ns stat "d"

load_config							;# CONFIG

cmsn_draw_main
cmsn_draw_notify

after 500 proc_ns
after 750 proc_sb

after 1000 cmsn_update_notify

if {$version != $config(last_client_version)} {
   cmsn_draw_about
}