package provide util 1.62



proc lremove remove {
upvar thelist y
set newlist ""

        foreach item $y {
                if ![string compare [string tolower [string trimleft $item "@+" ] ] [string tolower [string trimleft $remove "@+" ] ] ] {
                } else {
                        set newlist [linsert $newlist end $item]
                }
        }
        set y $newlist

}        

proc is_on_ignore {user type} {

        global ignore
        set iglist [split $ignore " "]

        foreach element $iglist {

                set igcat [split $element ","]
                set ig [lindex $igcat 0]
                set igtype [string tolower [lindex $igcat 1] ]

                set ig [string tolower $ig]
                set user [string tolower $user]
                if [string match "*m*" $igtype] {
                        if [string match $ig $user] { return 1 }
                }
                if [string match "*c*" $igtype] {
                        if [string match $ig $user] { return 1 }
                }
                if [string match "*p*" $igtype] {
                        if [string match $ig $user] { return 1 }
                }
                if [string match "*n*" $igtype] {
                        if [string match $ig $user] { return 1 }
                }
        }
        return 0

}
                              

proc get_shortnick lorig {
        upvar orig sorig

        if { [string first "!" $lorig] > -1 } {
                set sorig [string range $lorig 0 [string first "!" $lorig] ]
                set sorig [string trimright $sorig "!"]
                set response $sorig
         }


}
proc get_shortnick2 {orig} {

        if { [string first "!" $orig] > -1 } {
                set sorig [string range $orig 0 [string first "!" $orig] ]
                set sorig [string trimright $sorig "!"]
                return $sorig
         }

}

proc gfh {orig} {
# Return a formatted version of the user host
	
	set t [split $orig "!"]
	set nick [lindex $t 0]	
	set mask [lindex $t 1]
	if [sNull $mask] {
		set form "$nick"
	} else {
		set form "$nick \($mask\)"
	}
	return $form
}


proc get_nick_from_hostmask hostmask {

        upvar nickname sorig

        if { [string first "!" $hostmask] > -1 } {
                set sorig [string range $hostmask 0 [string first "!" $hostmask] ]
                set sorig [string trimright $sorig "!"]
                set response $sorig
        }

}             


proc get_nick_from_hostmask2 {hostmask} {


        if { [string first "!" $hostmask] > -1 } {
                set sorig [string range $hostmask 0 [string first "!" $hostmask] ]
                set sorig [string trimright $sorig "!"]
                return $sorig
        }

}
proc get_userhost_from_hostmask hostmask {

#        upvar userhost sorig

        if { [string first "!" $hostmask] > -1 } {
                set sorig [string range $hostmask  [string first "!" $hostmask] end ]
                set sorig [string trimleft $sorig "!"]
                return $sorig
        }

}

proc extract_msg param {
        upvar msg  mmsg
        upvar dest mdest

          set param [string trimleft $param " :=@"]
          scan $param "%s" mdest
          set mmsg [string range $param [string first $mdest $param] end ]
          set mmsg [string trimleft $mmsg $mdest]
          set mmsg [string trimleft $mmsg " "]

          if ![string compare ":" [string index $mmsg 0] ] {
                set mmsg [string range $mmsg 1 end]
          }

}                                        


proc togglemode {switch nick chan mode} {

	if ![string compare $nick ""] {
		return
	}

	if ![string compare "b" $mode] {
		return
	}

	if ![string compare "o" $mode] {
		set mode "@"
	}
	if ![string compare "v" $mode] {
		set mode "+"
	}

        if ![string compare "+" $switch] {
                        remove_nick $chan $nick
                        insert_nick $chan "$mode$nick"

        } else {
                        remove_nick $chan "$mode$nick"
                        insert_nick $chan $nick

        }
}
                          


proc is_me {orig} {
        global nick
	
	set orig [lindex [split $orig "!"] 0]
        if ![string compare [string tolower $orig] [string tolower $nick] ] {
        return 1
        } else {
        return 0
        }
}
proc ison {orig} {

        if [winfo exists ".zipperwin[winman $orig]"] {
                return 1
        } else {
        return 0
        }

}                       

proc insert_nick {chan user} {

        set chan [string tolower $chan]
        set win ".zipperwin[winman $chan]"
        if [ison $chan] {
        $win.list insert end $user
        set thelist [$win.list get 0 end]
        set thelist [lsort -command customsort $thelist]
        $win.list delete 0 end
        foreach name $thelist {
                $win.list insert end $name
        }
        }
}

proc remove_nick {chan user} {


        set chan [string tolower $chan]
        set win ".zipperwin[winman $chan]"
        if [ison $chan] {
        set thelist [$win.list get 0 end]
        lremove $user
        $win.list delete 0 end
        foreach name $thelist {
                $win.list insert end $name
        }
        }


}

proc insert_chan_list chan {

	if [string compare $chan ""] {
        set win ".zipperserver"
        $win.list insert end $chan
        set clist [.zipperserver.list get 0 end]
        set clist [lsort $clist]
        .zipperserver.list delete 0 end
        foreach element $clist {
                .zipperserver.list insert end $element
        }
	set w w[winman $chan]
	set schan [string range $chan 0 10]
	if ![winfo exists .chanmenu.chanb1.$w] {
		set isdcc [string range $chan 0 2]
		if ![string compare $isdcc "DCC" ] {
			set dnick [lindex [split $chan ":"] 1]
			set chan dcc[get_dcc_sock_from_nick $dnick]
		}
		if ![string compare [string index $chan 0] "\[" ] {
			set chan "\\$chan"
		}
		button .chanmenu.chanb1.$w -width 9 -font ZipperN -text $schan -command "do_query $chan 0"
	}
	pack .chanmenu.chanb1.$w -side top 
	}
}                                             

proc remove_chan_list chan {

        set name ""


        set thelist [.zipperserver.list get 0 end]
        lremove $chan
        lremove "> $chan"
        .zipperserver.list delete 0 end
        foreach name $thelist {
                .zipperserver.list insert end $name
        }
	set w w[winman $chan]
	if [winfo exists  .chanmenu.chanb1.$w ] {
		pack forget .chanmenu.chanb1.$w 
	}
}


proc format_user_command {command begin} {

        upvar myl yl
        upvar myc yc
        set yl [string range $yl [string first $begin $yl] end ]
        set yl [string trimleft $yl $yc]
        set yl [string trimleft $yl " "]
        set yl "$command $yl"

}

proc get_chan_name win {
  global response
  set win [lindex [split $win "."] 1]
  set win [string range $win 6 end]

  if ![string compare $win "server"] {
  set response  "server"
  return $response
  }
  
  if [string match "dcc*" $win] {
	set socket [string range $win 3 end]
	set snick [string tolower [get_dcc_nick_from_socket $socket] ]
	set response "dcc:$snick"
	return $response
  }
  if [winfo exists .zipper$win] {
  set win [lindex [split [wm  title .zipper$win] " "] 1]
  set response $win
  return $response
  }
  set reponse "-1"
  return $response
}
                       

proc is_active chan {
  global actwin
  global chaninfo

  set x $chaninfo($chan,name)
  set y ".[lindex [split $actwin "."] 1]"
  set state [wm state $x]

  if ![string compare $y $x] {
	if ![string compare $state "iconic"] {return 0}
	return 1
  } 
  return 0

}         



proc customsort {a b} {

	set x [string index $a 0]
	set y [string index $b 0]
	
	switch -exact -- $x {
		"@"	{set a "A$a" }
		"+"	{set a "B$a" }
		"_"	{set a "Z$a" }
		default {set a "G$a" }

	}
	switch -exact -- $y {
		"@"	{set b "A$b" }
		"+"	{set b "B$b" }
		"_"	{set b "Z$b" }
		default {set b "G$b" }

	}
        return [string compare [string tolower $a] [string tolower $b] ]

}    
proc init_user_rc {} {
	global rcdir
        global installpath
        global nick
        global altnick
        global username
        global realname
        global hostname
        global autorejoin
        global shortnick
        global server
        global port
	global textfg
	global textbg
	global device
	global notifywindow
	global appdir
	global webbrowser
	global autoacceptchat
	global autoacceptsend
	global dccsavdir
	global logdir
	global logchannels
	global logmsg
	global logdcc
	global serverpass
	global dccapplist
			
        set f [open $rcdir/zipperrc r]

        while 1 {
        set l [gets $f]
                if [ eof $f ] {
                        close $f
                        return 1
                }
                set comlist [split $l " "]
                set command [lindex $comlist 0]
                set param [join [string trimright [lrange $comlist 1 end] " " ] " "]
                set $command $param

        }

}     

proc init_stylecolors {} {
	global rcdir
	global kickcol
	global joincol
	global actcol
	global modecol
	global partcol
	global notfcol
	global notccol
	
        set f [open $rcdir/colorstylesrc r]

        while 1 {
        set l [gets $f]
                if [ eof $f ] {
                        close $f
                        return 1
                }
                set comlist [split $l " "]
                set command [lindex $comlist 0]
                set param [string trim [join [lrange $comlist 1 end] "" ] " " ] 
                set $command $param

        }


}                 

proc init_servers {} {

        global servers
	global rcdir 

        set servers ""
        set f [open $rcdir/serverrc r]


        while 1 {
        set l [gets $f]
                if [ eof $f ] {
                        close $f
                        return 1
                }
#                if [string compare "#" [string index $l 0] ] {
                        set servers [linsert $servers end $l]
#                }

        }





}                  
proc init_url {} {

        global urllist 
	global rcdir

        set urllist ""
        set f [open $rcdir/urlrc r]


        while 1 {
        set l [gets $f]
                if [ eof $f ] {
                        close $f
                        return 1
                }
#                if [string compare "#" [string index $l 0] ] {
                        set urllist [linsert $urllist end $l]
#                }

        }





}                  
proc init_users {} {

        global userlist 
	global rcdir

        set userlist ""
        set f [open $rcdir/usersrc r]


        while 1 {
        set l [gets $f]
                if [ eof $f ] {
                        close $f
                        return 1
                }
#                if [string compare "#" [string index $l 0] ] {
                        set userlist [linsert $userlist end $l]
#                }

        }





}                  



                                                                           
proc init_channels {} {

        global channels
	global rcdir

        set channels ""
        set f [open $rcdir/channelsrc r]


        while 1 {
        set l [gets $f]
                if [ eof $f ] {
                        close $f
                        return 1
                }
#                if [string compare "#" [string index $l 0] ] {
                        set channels [linsert $channels end $l]
#                }

        }





}
proc init_events {} {

        global eventlist
	global rcdir
        set eventlist ""
        set f [open $rcdir/eventsrc r]


        while 1 {
        set l [gets $f]
                if [ eof $f ] {
                        close $f
                        return 1
                }
#                if [string compare "#" [string index $l 0] ] {
                        set eventlist [linsert $eventlist end $l]
#                }

        }





}
                 

proc init_aliases {} {

        global aliaslist
	global rcdir

        set aliaslist ""
        set f [open $rcdir/aliasrc r]


        while 1 {
        set l [gets $f]
                if [ eof $f ] {
                        close $f
                        return 1
                }
#                if [string compare "#" [string index $l 0] ] {
                        set aliaslist [linsert $aliaslist end $l]
#                }

        }



}              

proc init_notify {} {

        global notify
	global rcdir

        set notify ""
        set f [open $rcdir/notifyrc r]


        while 1 {
        set l [gets $f]
                if [ eof $f ] {
                        close $f
                        return 1
                }
#                if [string compare "#" [string index $l 0] ] {
                        set notify [linsert $notify end $l]
#                }

        }



}

proc init_ignore {} {

        global ignore
	global rcdir
        set ignore ""
        set f [open $rcdir/ignorerc r]


        while 1 {
        set l [gets $f]
                if [ eof $f ] {
                        close $f
                        return 1
                }
#                if [string compare "#" [string index $l 0] ] {
                        set ignore [linsert $ignore end $l]
#                }

        }



}     

proc check_notify {} {
        global notify
        global esvrSock

        after 60000 {send_to_server $esvrSock "ISON $notify" ;check_notify}


}


proc init_check_rc {} {
        global installpath
	global rcdir

        if ![file exists $rcdir ] {
		wm withdraw .
                bgerror "Could not find zipper resource files.  Please cd to $installpath and execute the installrc script."
                exit
        }


}
 

# Read a line of text from stdin and send it to the echoserver socket,
# on eof stdin closedown the echoserver client socket connection
# this implements sending a message to the Server.
proc send_to_server {wsock l} {

  global serveractive
  global bytefloodlimit
  set x [string length $l]
  if $x>$bytefloodlimit {
	 set m [tk_dialog .userflood "Flood Limit Warning" "Flood Limit Exceeding..Hit Ok to send anyway." "error" 0 "ok"  "cancel" ]
	 if $m {return}
  }

  if $serveractive {
        puts $wsock $l           ;# send the data to the server
  }
}
              

proc fake_user_in {input} {

  global  esvrSock
  global  nick
  global  eventLoop

  set input [string trim $input " "]
  set w [focus]
  set l $input

  if [sNull $l] return
  set w [string range $w 7 end ]
  set w [string range $w 0 [string first "." $w] ]
  set w [string trimright $w "."]
  if [string compare "" $w] {
        set chan [lindex [split [wm  title .zipper$w] " "] 1]
  }
#default is to send to current channel
  if ![string compare "/" [string index $l 0] ] {
	
        	set l [string trimleft $l " /"]
       		set_command $l $esvrSock
  } else {

        if ![string compare ".zipperserver" $w] {
        } else {
          send_to_window $chan "> $l\n"
          set l ":$nick PRIVMSG $chan :$l"
          send_to_server $esvrSock $l ;# send the data to the server
          }
  }


}

                          

proc read_user_in {wsock w} {
  global  nick
  global  eventLoop
  global  history
  global  historyidx
  global  chef
  
  set l [$w get]
  $w delete 0 end

  set hname [get_chan_name $w]
  set historyidx($hname)  30
  lappend history($hname) $l
  roll_off_hist $hname

  

  set w [string range $w 7 end ]
  set w [string range $w 0 [string first "." $w] ]
  set w [string trimright $w "."]
  set chan [lindex [split [wm  title .zipper$w] " "] 1]


#default is to send to current channel

  if [sNull $l] return

  set lines [split $l "\n"] 

  foreach line $lines	{
  if ![string compare "/" [string index $line 0] ] {
        set line [string trimleft $line "/"]
        if [string compare "" $line] {
                set_command $line $wsock
        }
  } else {

        if ![string compare "server" $w] {
        } else {
	  if $chef { set line [exec chef.sh $line] }	
          send_to_window $chan "> $line\n"
          set line ":$nick PRIVMSG $chan :$line"
          send_to_server $wsock $line ;# send the data to the server
          }
  }
 }


}                            


 
proc set_chan_activity {status win} {
	global chaninfo
	global installpath

        set win [string tolower $win]

	set zwin $chaninfo($win,name)
	set type $chaninfo($win,type)
	set tnick $chaninfo($win,nickchan)

### the old way for channel list
	if ![string compare $type "dcc" ] { 
		set win "DCC:$tnick"
	}

	set x [chan_exists $win]
	if !$x {return}

        if [string match "" $win] { return }
        if [string match "on" $win] { return }
        if [string match "channel*" $win] { return }
        if [string match "server*" $win] { return }

        if $status {
#                remove_chan_list $win
#                remove_chan_list "> $win"
#                insert_chan_list "> $win"
		wm iconbitmap $zwin "@$installpath/zipperwinicon2.xbm"
		set w w[winman $win]
		.chanmenu.chanb1.$w configure -foreground red
        } else {
#                remove_chan_list "$win"
#                remove_chan_list "> $win"
#                insert_chan_list "$win"
		wm iconbitmap $zwin "@$installpath/zipperwinicon.xbm"
		set w w[winman $win]
		.chanmenu.chanb1.$w configure -foreground black
        }

}
                                        
proc update_chan_activity {status win} {
global actwin

	set actwin $win
        if [string match "*dcc*" $win] { 
		set win [lindex [split [string range $win 7 end] "."] 0]
		if [sNull $win] {return}
	} else {
        	set win [get_chan_name $win]
	}
        set_chan_activity 0 $win
}



proc substitute {newcommand fromnick fromchannel line} {


	global nick
	global ip
	global username
	global myuserhost
	global realname
	global hostname
	global server
	global port
	global version
	global currchan
	global varlist	
	global actwin

	set level [get_level $fromnick]		
	set fromuser $fromnick
	set fromnick [get_nick_from_hostmask2 $fromnick]
	set newcommand [string trim $newcommand " "]	
	set oldcommand $newcommand
	
	set list [split $oldcommand " "]
	set newlist ""
	foreach word $list {
		set check [string tolower $word]

		if ![string compare "-$" [string range $check 0 1] ] {
			set check [string range $check 1 end]
			set pc [string range $check 1 4]
			switch -exact -- $pc {
			parm	{ set num [string range $check 5 end]
				  incr num -1
				  set check [lindex [split $line " "] $num] 	
				}
			default	{set x [catch {set check [expr $check] } ]
				 if $x {fake_user_in "/echo Unknown parameter $word" }
				 }
			}
			set newlist [linsert $newlist end $check]
		} elseif ![string compare "-%" [string range $check 0 1] ] {
			set check [string range $check 2 end]
			set check [varvalue $check]
			set newlist [linsert $newlist end $check]
		} elseif ![string compare "-@" [string range $check 0 1] ] {
			set check [string range $check 2 end]
			set check [funcvalue $check $fromuser $fromchannel $line]
			set newlist [linsert $newlist end $check]
		} elseif ![string compare "#" $check ] {
                                       set cn [get_chan_name [focus] ]
                                       set newlist [linsert $newlist end $cn]
                } elseif ![string compare "?" $check] {
                                        set x [ask_user "Question" "Enter Channel Name" ]
                                        set newlist [linsert $newlist end $x] 
		} else {
			set newlist [linsert $newlist end $word]

		}
	}
	set list $newlist

	set newcommand [join $newlist " "]
	return $newcommand
}



#proc do_menu_command {win index type} {
proc do_menu_command {win com type } {
#global userpopups
global nick

	set win ".[lindex [split $win "."] 1]"

	switch -exact -- $type {
		channel		-
		query		{set parm1 [get_chan_name [focus]] }
		userlist	-
		notify		{set parm1 [string trimleft [$win.list get active] "@+"]}
	}
#	set index [expr $index - 1]
#	set com [lindex $userpopups($type) $index]
	set command $com
	action_exec $command $nick NA $parm1

}


proc sNull {string} {

	if ![string compare $string ""] {

		return "1"

	}
	return "0"

}

proc aliasindex {alias} {
	global aliaslist
	set index -1
	foreach var $aliaslist {	
		incr index
		set v [lindex [split $var " "] 0]
		if ![string compare $v $alias] {
			return $index
		}
	}
	return -1
}


proc varindex {varname} {
	global varlist
	set index -1
	foreach var $varlist {	
		incr index
		set v [lindex [split $var " "] 0]
		if ![string compare $v $varname] {
			return $index
		}
	}
	return -1
}

proc varset {var value} {
  	global varlist   
        if [expr [set index [varindex $var]] >= 0] {
                set varlist [lreplace $varlist $index $index "$var $value"]
        } else {
                lappend varlist "$var $value"
        }                                                                    


}


proc varvalue {varname} {

	global varlist
        set index [varindex $varname]
	set value [string trim [join [lrange [split [lindex $varlist $index] " " ] 1 end] " " ]  ] 
        return $value 

}


proc funcvalue {function fromuser channel line} {
	global whoisvisible
	global whoisuser
	global nick
	global actwin

	set p(1) ""
	set p(2) ""
	set p(3) ""
	set p(4) ""
	set p(5) ""
	set p(6) ""

	set funclist [split $function ","]
	set function [lindex $funclist 0]
	set parmlist [lrange $funclist 1 end]

	set x 0
	foreach parm $parmlist {
		incr x
		if ![string compare "-" [string range $parm 0  0 ] ] {
                       	set parm [substitute $parm $fromuser $channel $line]
                }
		set p($x) [string trim $parm]
	}
	set cmdline "$p(1) $p(2) $p(3) $p(4) $p(5) $p(6)" 
	set plist "$p(2) $p(3) $p(4) $p(5) $p(6)" 

	switch $function {
	"level" { 	set whoisvisible 0
			fake_user_in "/echo Looking up user..."
			fake_user_in "/whois $p(1)"
			tkwait variable whoisvisible
			return [get_level $whoisuser] 
		 }
	"longip" { return [encodeip $p(1) ]  }
	"shortip" { return [decodeip $p(1) ]  }
	"date" {  return [date]  }
	"add"	{ return [expr $p(1) + $p(2) ] }
	"cat"	{ 	set c "$p(1)$p(2)" 
			return $c }
	"sub"	{ return [expr $p(1) - $p(2) ]  }
	"rtime"  { return [clock seconds] }
	"run"	{ return [runpgm $cmdline] }
	"none"	{ return }
	"strange"	{ set start $p(1)
		  set end   $p(2)
		  set str   $p(3)
		  set s [string range $p(3) $start $end]
		  return $s}
	"prange" {	set p(1) [expr $p(1)-1]
			if [string compare $p(2) "end"] {
				set p(2) [expr $p(1)-1]
			}
			set linex [join $line]
			set xlist [split $linex " "]
			set pr [lrange $linex $p(1) $p(2)]
			return [join $pr " "]
		}
	"tcl"   { return [eval $cmdline] } 
	"time"  { return [time] }
	"window"	{ return [get_chan_name $actwin] }

	"chanlist" { 	set chan $p(1)
			if [is_channel $chan] {
			set list [.zipperwin[winman $chan].list get 0 end]
			return $list
			}
			return ""
		  }	
	default	  { fake_user_in "/echo Unknown Function [$function]" }


	}
}



proc process_options {ircuser} {




}


proc get_level {ircuser} {
	global nick
	global userlist

 	set level 0

	foreach user $userlist {	
                set lvs [split $user ":"]
                set ulev [lindex $lvs 0]
                set uname [lindex $lvs 1]
                if [string match $uname $ircuser] {
                        set level $ulev
                        return $level
                }

        } 
	return $level


}

proc get_user_list_entry {ircuser} {
	global userlist

	foreach user $userlist {	
                set lvs [split $user ":"]
                set uname [lindex $lvs 1]


                if [string match $uname $ircuser] {
                        return $uname
                }

        } 
	return "*"
}



proc join_channel_from_list {} {

	set w ".zipperchannellist.channels.list"  
	set item [$w get active]
	set channel [lindex [split $item "\t"] 0]
	fake_user_in "/join $channel"

}

proc playsystembell {} {



}


proc loadscript {script} {
	global nick

	if [file exists $script] {
	set f [open $script r]
	 while 1 {
     	   set l [gets $f]
                if [ eof $f ] {
                        close $f
                        return 1
                }
	   set command $l
	   action_exec $command $nick "N/A" ""
	}
	} else {
		fake_user_in "/echo $script not found!"
	}



}


proc is_channel {channel} {
global chaninfo

	set channel [string trimleft $channel "> "]
	if [sNull [array names chaninfo "$channel,name"] ] {
                return 0
        } else {
		if ![string compare "chan" $chaninfo($channel,type)] {
                return 1
		}
        }
 	return 0

}

proc channel {c} {

	set c [string trim $c " "]
	if ![string compare "#" $c] {
		set c [get_chan_name [focus] ]
	}
	return $c

}

proc center {t  xoff yoff} {

	set x [expr [winfo screenwidth $t]/2 - [winfo reqwidth $t]/2 \
            - [winfo vrootx [winfo parent $t]]]
    	set y [expr [winfo screenheight $t]/2 - [winfo reqheight $t]/2 \
            - [winfo vrooty [winfo parent $t]]]         
	
	set x [expr $x+$xoff] 
	set y [expr $y+$yoff] 
	wm geom $t +$x+$y  


}

proc max_size { t } {

	set x [winfo screenwidth $t]
	set y [winfo screenheight $t]

	return "$x,$y"
}

proc set_popups {} {

	global rcdir
	global userpopups

	set muser .zipperserver.menu.userlistpopup
	set mnoti .zipperserver.menu.notifypopup
	set mchan .zipperserver.menu.channelpopup      
	set mquery .zipperserver.menu.querypopup      
	
	menu $muser -tearoff no -font ZipperMenu
	menu $mnoti -tearoff no -font ZipperMenu
	menu $mchan -tearoff no -font ZipperMenu
	menu $mquery -tearoff no -font ZipperMenu

	set submenu 0

	set f [open $rcdir/popuprc r]


	while 1 { 
		set l [gets $f]
		if [eof $f] {
			close $f
			return
		}
		switch -exact -- $l {
			"[USERLIST]"	{set m $muser; set t userlist }
			"[NOTIFY]"	{set m $mnoti; set t notify }
			"[CHANNEL]"	{set m $mchan; set t channel }
			"[QUERY]"	{set m $mquery; set t query }
			"[-]"		{ }
		}
		set ck [string range $l 0 0]
		if [string compare $ck "\[" ] {
			 if ![string compare [lindex [split $l " "] 0]  "-"] {
                        $m add separator
			set userpopups($t) [linsert $userpopups($t) end " "]  
                        $m add  command -label [string trimleft $l "-"] -foreground red
                       	set userpopups($t) [linsert $userpopups($t) end " "]   
			$m add separator
			set userpopups($t) [linsert $userpopups($t) end " "] 
               		 } else {
                	set lab [lrange [split $l " "] 0 0 ]
                	set com [join [lrange [split $l " "] 1 end] " "]
                	set com [join [split $com "-"] "-\\"]
#			set mc "do_menu_command \[focus\] \[$m index active\] $t"
			set mc "do_menu_command \[focus\] \"$com\" $t"
#			set userpopups($t) [linsert $userpopups($t) end "$com"] 
                	$m add command -label $lab -command $mc
                	}                        
		}



	}
}

proc select_history {window i} {
	global historyidx
	global history


	set index [get_chan_name $window]
	set l [llength $history($index) ]
	incr historyidx($index) $i
	if [expr $historyidx($index)<0] {
		set historyidx($index) 0
	}
	if [expr $historyidx($index)>$l] {
		set historyidx($index) [expr $l-1 ]
	}

	set out [lindex $history($index) $historyidx($index)]
	$window delete 0 end
	$window insert end $out

}

proc roll_off_hist { index } {
	global history
	
	set l [llength $history($index)]
	if $l>25 {
	
	set history($index) [lrange $history($index) 10 end]

	}

}


proc set_styles {} {

global kickst
global joinst
global notfst
global notcst
global actst
global partst
global modest

global joincol
global kickcol
global notfcol
global notccol
global actcol
global partcol
global modecol


set kickst "\003$kickcol"
set joinst "\003$joincol"
set notfst "\003$notfcol"
set notcst "\003$notccol"
set actst  "\003$actcol"
set partst "\003$partcol"   
set modest "\003$modecol"   

}


proc chan_exists {channel} {
	
	set channel [string tolower $channel]	
	if [string match $channel "server"] {return 1}
	set list [.zipperserver.list get 0 end]
	foreach item $list {
		set item [string tolower [string trim $item "> "] ]
		if ![string compare $item $channel ] {return 1}
	}
	return 0


}


proc writeln {filename data} {
#write a line of data to the end of a file
	set f [open $filename "a+" ]
	puts $f $data
	close $f
}


proc readln {filename line} {
#read a line of data from a file specified by line
set r [exec head --lines $line $filename | tail --lines 1 ]
return $r

}


proc readrand {filename} {
#read a line at random from a file
}




proc update_flood_data {hostmask} {
	global flooddetect
	global flooddetectsecs
	global flooddetectlimit

	if [sNull $hostmask] {return 0}
	if [sNull [array names flooddetect "$hostmask,count" ] ] {
		set flooddetect($hostmask,count)  $flooddetect(userhost,count) 
		set flooddetect($hostmask,start)  [clock seconds]
		set flooddetect($hostmask,avglpm) $flooddetect(userhost,avglpm)  
	}

	incr flooddetect($hostmask,count)	
	set count $flooddetect($hostmask,count)
	set limit $flooddetectlimit
	set time [clock seconds]
	set elapsed [expr $time-$flooddetect($hostmask,start) ]
	set elapsetime [expr $elapsed+$flooddetect($hostmask,start) ]
	set expire [expr $flooddetect($hostmask,start)+$flooddetectsecs ]
	set avg [expr $elapsed/$flooddetect($hostmask,count) ]

#puts "count       	$count"
#puts "time     		$time"
#puts "elapsed  		$elapsed"
#puts "elapsetim		$elapsetime"
#puts "expires  		$expire"
#puts "avg      		$avg"
	
	if $elapsetime>=$expire {
#puts "expired reseting $hostmask"
		set flooddetect($hostmask,count) 0
		set flooddetect($hostmask,start) [clock seconds]
		set flooddetect($hostmask,avglpm) $avg	
		return 0
	}

	set flooddetect($hostmask,avglpm) $avg	
	
	if $count>$limit {
		fake_user_in "/echo ***  \0034Flood detected from $hostmask"
		return 1
	}
	return 0
}

proc processtimers {} {
#
#format:  "TYPE|WHEN|INTERVAL|ACTION"
#

	global timerarray

	set time [clock seconds]

	set tlist [array names timerarray]
	foreach element $tlist {
	
	set xlist [split $timerarray($element) "|" ]

	set type [lindex $xlist 0]
	set when [lindex $xlist 1]
	set interval [lindex $xlist 2]
	set action [lindex $xlist 3]

	if $time>=$when {
		fake_user_in "$action"
		incr when $interval
		set info "$type|$when|$interval|$action"
		kill_timer $element
		add_timer $element $info
		if ![string compare $type "once"] {
			kill_timer $element
		}
	}	
}
after 1000 processtimers
}

proc add_timer {num info} {
	global timerarray
	set timerarray($num) $info
}

proc kill_timer {num} {
	global timerarray
	unset timerarray($num) 
}


proc update_notify {list} {

global notifywindow 

        if [winfo exists .zippernotify] {

        } else { notify_window }
        .zippernotify.list delete 0 end       

	foreach item $list {
		.zippernotify.list insert end $item
	}
}

proc toggle_notify_win {} {
global notifywindow
global isonlist

	if !$notifywindow { destroy .zippernotify 
	} else {	
		notify_window
		update_notify $isonlist
	}	

}


proc minimize {w} {

	set window [lindex [split $w "."] 1]
	wm iconify .$window

}

proc create_fonts {} {

	font create ZipperN -family Courier -size 12 -weight normal -slant roman 
	font create ZipperB -family Courier -size 12 -weight bold -slant roman
	font create ZipperBBar -family helvetica -size 10 -weight normal
	font create ZipperMenu -family helvetica -size 10 -weight normal
	font create ZipperTopic -family Times -size 12 -weight normal


}

proc secs_to_time {secs} {

	set time ""
	set hours [expr int($secs/3600) ]
	set hourc [expr $hours*3600]
	set secr [expr $secs-$hourc]
	set min [expr int($secr/60)]
	set minc [expr int($min*60)]
	set secr [expr $secr-$minc]


	if $hours {
                set time "$hours Hours, "
	}

	if $min {
                set time "$time $min Minutes,"
        }
        set time "$time $secr Seconds"
                                          
	return $time
}



proc playsound {sf} {
	global dccapplist

	set pgm [decodeapp $sf $dccapplist]

	if [file exists $sf] {
		catch {set r [ runpgm "$pgm $sf > /dev/null &"] }
	} else {
		send_to_window server "No Such File: $sf \n"
	}
}


proc grab_url {input} {
global urllist

	set input [string tolower $input]
	set s [string first "http://" $input]

	if $s>=0 {

		set url [string range $input $s end]
		set e [string first " " $url]
		if $e<0 {
			set e [string length $url]	
		}
		set url [string range $url 0 $e]
		set x [lsearch -exact $urllist $url]
		if $x==-1 {
			if [lsearch -exact $urllist $url]<0 {
				lappend urllist $url
				if [winfo exists .zipperurl] {
					.zipperurl.box.list insert end $url
				}
			}
		}
	}


}

proc launch_url {url} {
	global webbrowser
	fake_user_in "/echo Launching $url"

	set x [ catch { runpgm "$webbrowser -remote \"openURL($url)\" &"   } ct ]


	if $x {
		"Could not connect to remote $webbrowser, attempting to start."
		set x [ catch {exec $webbrowser $url & } ct ]
	}
	if $x {
		puts "Could not start $webbrowser."
		bgerror $ct
	}

}


proc set_chan_mode {chan mode} {
#  reset mode array
array set modes {
	s ""
	p ""
	m ""
	t ""
	i ""
	n ""
	m ""
	l ""
	k ""
}

## Get Current Modes
	set cmodes [[winman2 $chan].labels.modes get]
	set ar [array names modes]
	foreach item [split $cmodes ""] {
		if [string match *$item* $ar] {
			set modes($item) $item
		}	

	}
	set cmodes $mode
	set v "+"
	foreach item [split $cmodes ""] {
		if [string match *$item* "+"] {
			set v "+"
		}
		if [string match *$item* "-"] {
			set v "-"
		}

		if [string match *$item* $ar] {
			switch -exact -- $v {
			"+"	{ set modes($item) $item }
			"-"	{ set modes($item) "" }
			}
		}
	}
	set mode ""
	foreach i $ar {
			set mode $mode$modes($i)
	}	

	if [winfo exists [winman2 $chan] ] {
	
		[winman2 $chan].labels.modes configure -state normal
		[winman2 $chan].labels.modes delete 0 end
		[winman2 $chan].labels.modes insert end $mode
		[winman2 $chan].labels.modes configure -state disabled
	}
}




proc runpgm {cmdline} {

	set s [eval exec $cmdline]
	return $s
}

proc date {} {
	set time [clock seconds]
	return [clock format $time -format %D]

}
proc time {} {
	set time [clock seconds]
	return [clock format $time -format %T]

}


proc change_win_index {oldnick newnick} {
global chaninfo
global chanrev

	set oldnick [string tolower $oldnick]
	set newnick [string tolower $newnick]
	set index $newnick

	set chaninfo($index,name) $chaninfo($oldnick,name) 
	set chaninfo($index,type) $chaninfo($oldnick,type)
        set chaninfo($index,nickchan) $chaninfo($oldnick,nickchan)
        set chaninfo($index,stat) $chaninfo($oldnick,stat)
        set chaninfo($index,history)  $chaninfo($oldnick,history)
        set chaninfo($index,historyidx)  $chaninfo($oldnick,historyidx)
        set chaninfo($index,winnumber) $chaninfo($oldnick,winnumber)
        set chaninfo($index,socket) $chaninfo($oldnick,socket)
        

	set chanrev($chaninfo($index,name)) $index                

	unset chaninfo($oldnick,name)
	unset chaninfo($oldnick,type)
	unset chaninfo($oldnick,nickchan)
	unset chaninfo($oldnick,stat)
	unset chaninfo($oldnick,history)
	unset chaninfo($oldnick,historyidx)
	unset chaninfo($oldnick,winnumber)
	unset chaninfo($oldnick,socket)
}



proc action_exec {action fromnick fromchannel line} {

## Support for "Old Style" commands and "New TCL Code" Commands

#	set action [substitute $action $fromnick $fromchannel $line]

	set action [string trim $action]
	set type [string index $action 0]
	switch -exact -- $type {

	"/"	{ action_exec_old $action $fromnick $fromchannel $line}
	"\{"	{ action_exec_tcl $action $fromnick $fromchannel $line}

	}

		

}


proc action_exec_old {action fromnick fromchannel line} {

	set l [split $action ";"]
	foreach command $l {
		set command [substitute $command $fromnick $fromchannel $line]
		fake_user_in $command
	}                              


}

proc action_exec_tcl {action fromnick fromchannel line} {
	set action [string trim $action "\{\}" ]

	set l [split $action ";"]
	foreach command $l {
		set action [substitute $command $fromnick $fromchannel $line]
		eval $action
	}	
}

proc irc {command} {

	fake_user_in $command
}


proc pick_color {} {
global mirccolors
global tmpcolor

	set w .colorpick
	toplevel $w
	frame $w.f1
	frame $w.f2
	frame $w.f3
	frame $w.f4
	pack $w.f1 -side top
	pack $w.f2 -side top
	pack $w.f3 -side top
	pack $w.f4 -side top

	for {set i 0} {$i<4} {incr i} {
		button $w.f1.color$i -background $mirccolors($i) -command "destroy .colorpick; set tmpcolor $i"
		pack $w.f1.color$i -side left
	}
	for {set i 4} {$i<8} {incr i} {
		button $w.f2.color$i -background $mirccolors($i) -command "destroy .colorpick; set tmpcolor $i"
		pack $w.f2.color$i -side left
	}
	for {set i 8} {$i<12} {incr i} {
		button $w.f3.color$i -background $mirccolors($i) -command "destroy .colorpick; set tmpcolor $i"
		pack $w.f3.color$i -side left
	}
	for {set i 12} {$i<16} {incr i} {
		button $w.f4.color$i -background $mirccolors($i) -command "destroy .colorpick; set tmpcolor $i"
		pack $w.f4.color$i -side left
	}

	tkwait window .colorpick
	return $tmpcolor
}


proc openlog {logname} {
global chaninfo
global logdir
	
	set name [string tolower $logname]
	if ![string compare $chaninfo($logname,type) "dcc" ] {
		set name "DCC_[get_dcc_nick_from_socket $chaninfo($logname,socket)]"
	}
	set fname [file join $logdir $name]
	if ![file exists $logdir] {
		file mkdir $logdir
	}	

	set fp [open $fname "a+"]
	set date [date]
	set time [time]
	puts $fp "Logging Started for $name, on $date at $time"
	set chaninfo($logname,logfile) $fp
}

proc closelog {logname} {
global chaninfo

	set logname [string tolower $logname]
	set name $logname

	catch { set x $chaninfo($logname,type) }
	if ![string compare $chaninfo($logname,type) "dcc" ] {
		set name "dcc[get_dcc_nick_from_socket $chaninfo($logname,socket)]"
	}

	set fp $chaninfo($logname,logfile)
	if ![sNull $fp] {
	set date [date]
	set time [time]
	puts $fp "Logging Ended for $name, on $date at $time"
	close $fp
	set chaninfo($logname,logfile) ""
	}
}
proc closealllogs {} {
global chaninfo
	set nlist [array names chaninfo "*logfile"]
	foreach log $nlist {
		closelog [lindex [split $log ","] 0]

	}

}

proc add_to_log {file text} {
	puts -nonewline $file $text


}


proc toggle_logging {w} {
	global chaninfo
	global chanrev

	set win [string tolower $chanrev($w) ]
	if ![sNull $chaninfo($win,logfile) ] {
		closelog $win
	} else {
		openlog $win
	}
	

}
proc decodeapp {file apps} {
       
	set xl [split $file "."]
        set filetype [lindex $xl end]

        set al [split $apps ","]
        foreach item $al {
                set typ [lindex [split $item "="] 0]
                set pgm [lindex [split $item "="] 1]
                if [string compare $typ $filetype]==0 {
                        return $pgm
                }
        }
	set pgm ""
	return $pgm


}
proc showfile {file apps} {


	set pgm [decodeapp $file $apps]	
	if ![sNull $pgm] {
        	exec $pgm $file &
	}

}       
proc decodeappdir {file dirs} {
       
	set xl [split $file "."]
        set filetype [lindex $xl end]
        set al [split $dirs ","]
        foreach item $al {
                set typ [lindex [split $item "="] 0]
                set dir [lindex [split $item "="] 1]
                if [string compare $typ $filetype]==0 {
                        return $dir
                }
        }
	set dir ""
	return $dir


}
