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 "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