xkitty.tcl

namespace eval irc {}

proc irc::newdata {conn server} {
	global irc::connections
	global tcl_platform
	set status [gets $conn newline]
	if {$status < 0} {
		if {![fblocked $conn] || [eof $conn]} {
			fileevent $conn readable [list]
			close $conn
			set irc::connections($server) 0
			irc::connect $server $irc::connections($server,port) $irc::connections($server,pass) $irc::connections($server,nick)\
				$irc::connections($server,user) $irc::connections($server,realname) $irc::connections($server,encoding)
		}
	} else {
		set spc1 [string first " " $newline]
		set spc2 [string first " " $newline [expr $spc1 + 1]]
		if {[string index $newline 0] eq ":"} {
			set sender [string range $newline 1 $spc1]
			set nick [lindex [split $sender "!"] 0]
		} else {
			set sender $server
			set nick $server
			set spc2 $spc1
			set spc1 0
		}
		set cmd [string trim [string range $newline $spc1 $spc2]]
		set params [string trim [string range $newline $spc2 end]]
		set params1 [string trim [string range $params 0 [expr [string first ":" $params] - 1]]]
		set params2 [string range $params [expr [string first ":" $params] + 1] end]
		set noidprefix ""
		if {($irc::connections($server,capab)) && (([string index $params2 0] eq "+") || ([string index $params2 0] eq "-"))} {
			set noidprefix [string range $params2 0 0]
			set params2 [string range $params2 1 end]
		}
		if {($cmd eq "PRIVMSG") && ([string first "xkitty: hug " $params2] == 0)} {
			set hugnick [lindex [split $params2 " "] 2]
			puts $conn "PRIVMSG $params1 :\001ACTION jumps on $hugnick's head and jumps and jumps... and *hugs*\001"
		}
		if {($cmd eq "PRIVMSG") && ([string first "xkitty: hi" $params2] == 0)} {
			puts $conn "PRIVMSG $params1 :hi $nick *^^*"
		}
		if {($cmd eq "PRIVMSG") && ($params1 eq "xkitty") && ($nick eq "RudyValencia")} {
			puts $conn "PRIVMSG $params2"
		}
		if {($cmd eq "005") && ([string first "CAPAB" $params] >= 0)} {
			puts $conn "CAPAB IDENTIFY-MSG"
			puts $conn "CAPAB IDENTIFY-CTCP"
			set irc::connections($server,capab) 1
		}
		if {($cmd eq "005") && ([string first "NICKLEN=" $params] >= 0)} {
			set nptr [expr [string first "NICKLEN=" $params] + 8]
			set irc::connections($server,nicklen) [string range $params $nptr [expr [string first " " $params $nptr] - 1]]
			puts $conn "JOIN ##xteddy"
		}
		if {($cmd eq "PRIVMSG") && ($params2 eq "\001VERSION\001")} {
			puts $conn "NOTICE $nick :\001VERSION xkitty 0.01alpha - running on $tcl_platform(os)\
				$tcl_platform(osVersion) \[$tcl_platform(machine)\] - hug me *^^*\001"
		}
		if {($cmd eq "PRIVMSG") && ([string first "\001PING " $params2] == 0)} {
			puts $conn "NOTICE $nick :$params2"
		}
		if {$cmd eq "PING"} {
			puts $conn "PONG :$params2"
		}
	}
}

proc irc::connect {server port pass nick user realname encoding} {
	global irc::connections
	if {[lsearch [array names irc::connections] $server] >= 0} {
		if {$irc::connections($server)} {
			return
		}
	}
	if {[catch {
		set conn [socket $server $port]
		fconfigure $conn -blocking 0 -encoding $encoding -buffering line
		fileevent $conn readable [list irc::newdata $conn $server]
		if {$pass ne ""} {
			puts $conn "PASS $pass"
		}
		puts $conn "NICK $nick"
		puts $conn "USER $user xkitty xkitty :$realname"
		set irc::connections($server) 1
		set irc::connections($server,socket) $conn
		set irc::connections($server,server) $server
		set irc::connections($server,port) $port
		set irc::connections($server,pass) $pass
		set irc::connections($server,nick) $nick
		set irc::connections($server,user) $user
		set irc::connections($server,realname) $realname
		set irc::connections($server,encoding) $encoding
		set irc::connections($server,capab) 0
		set irc::connections($server,nicklen) 9
	}]} {after 5000 irc::connect $server $port $pass $nick $user $realname $encoding}
}

irc::connect irc.freenode.net 6667 "" xkitty xkitty "xkitty - huggable tcl script" utf-8
vwait forever