proc , args {#avoid clash with comment syntax highlighting on a wiki page}
, We will use the Tk GUI toolkit, so best tell it early on}
package require Tk
, Set some parameters (user may want to modify these)
set ::server irc.freenode.org
set ::chan #tcl
set ::me $tcl_platform(user)
, The GUI consists mostly of a text widget:
text .t -height 30 -wrap word -font {Arial 9}
, Some tags to make emphasized strings look nicer:
.t tag config bold -font [linsert [.t cget -font] end bold]
.t tag config italic -font [linsert [.t cget -font] end italic]
.t tag config blue -foreground blue
, Second UI element is an entry widget for typing messages
entry .cmd
, Brought to screen by pack (entry first, so it doesn't disappear on resizing)
pack .cmd -side bottom -fill x
pack .t -fill both -expand 1
, When <Return> is hit in the entry, the command post is executed
bind .cmd <Return> post
, But first for the receiving proc, which is called when the socket has new
, content:
proc recv {} {
gets $::fd line ;#-- read a line from socket
# handle PING messages from server
if {[lindex [split $line] 0] eq {PING}} {
send "PONG info hostname [lindex [split $line] 1]"
return
}
#-- Add some markup for messages and actions
if {[regexp {:([^!]*)![^ ].* +PRIVMSG ([^ :]+) +:(.*)} $line -> \
nick target msg]} {
set tag {}
if {[regexp {\001ACTION(.+)\001} $msg -> msg]} {set tag italic}
#-- suppress the names of two well-known bridge bots
if {[in {azbridge ijchain} $nick]} {regexp {<([^>]+)>(.+)} $msg -> nick msg}
#-- Display nick in bold, message as tagged above
.t insert end $nick\t bold $msg\n $tag
} else {.t insert end $line\n italic}
#-- make sure the last part is visible
.t yview end
}
, Just a little helper to check list membership
, In later versions of Tcl, the "in" operator of expr could be used instead
proc in {list element} {expr {[lsearch -exact $list $element]>=0}}
, This command is called on <Return>
proc post {} {
set msg [.cmd get] ;#-- read what was typed in the entry
#-- Lines beginning with /me are marked as actions:
if [regexp {^/me (.+)} $msg -> action] {set msg "\001ACTION $action\001"}
#-- Multiple lines (as e.g. from pasting) are sent one by one:
foreach line [split $msg \n] {send "PRIVMSG $::chan :$line"}
.cmd delete 0 end ;#-- clear the entry
#-- the sent message is locally reported in the text, with possible markup
set tag ""
if [regexp {\001ACTION(.+)\001} $msg -> msg] {set tag italic}
.t insert end $::me\t {bold blue} $msg\n [list blue $tag]
#-- make sure the end of the text widget is visible
.t yview end
}
, A very simple wrapper for sending a string, not forgetting to flush
proc send str {puts $::fd $str; flush $::fd}
, And now, the action begins with "logging in" to the IRC server
set ::fd [socket $::server 6667]
send "NICK $::me"
send "USER $::me 0 * :PicoIRC user"
send "JOIN $::chan"
, If the socket gets readable, recv will be called
fileevent $::fd readable recv
, This is just a convenient debugging helper for rapid restart after changes
bind . <Escape> {exec wish $argv0 &; exit}How does this script deal with the ping-pong requirements of an IRC server? Is that handled by the socket itself?RS: The script as above worked nicely from home (at work, IRC is blocked). I think I remember timeouts if I wasn't chatting for a while, but I'm not an IRC specialist anyway... Who knows better, please let us know!MJ: The handling of the PING request has been added to the script.Regarding that particular segment of code;
send "PONG [info hostname]"can someone explain the info hostname command to me?LV: Did you read the wiki page to which you referred? Basically, every computer has some sort of name - info hostname returns that name.No I didn't read that page... posted the question without even looking at it afterwards. Many thanks to you all though! You've been very helpful!
Alternatively, some servers send ping requests with a unique key that must be returned.a rawlog excerpt from xchat on irc.sorcery.net:
<< PING LAG2509966063 >> :nebula.sorcery.net
PONG nebula.sorcery.net :LAG2509966063In that case, the following replacement of the server code can suffice (if not, please edit):if {[lindex [split $line] 0] eq {PING}} {
send "PONG [lindex [split $line] 1]"
return
}MJ: The return from xchat seems to violate RFC1459, to quote:Command: PONG Parameters: <daemon> [<daemon2>] PONG message is a reply to ping message. If parameter <daemon2> is given this message must be forwarded to given daemon. The <daemon> parameter is the name of the daemon who has responded to PING message and generated this message.So the first parameter of pong should be the name of the daemon who has responded (e.g. the name of the client)Therefore the way I read it, the correct reply should be:
if {[lindex [split $line] 0] eq {PING}} {
send "PONG [info hostname] [lindex [split $line] 1]"