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}

send "PONG [info hostname]"

<< PING LAG2509966063 >> :nebula.sorcery.net
     PONG nebula.sorcery.net :LAG2509966063

if {[lindex [split $line] 0] eq {PING}} {
    send "PONG [lindex [split $line] 1]" 
    return
}

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.

if {[lindex [split $line] 0] eq {PING}} {
    send "PONG [info hostname] [lindex [split $line] 1]"