I ([FW]) created a little (~4k) chatserver in Tcl, which allows people to connect via a [telnet] client, or some other raw text-based program, and chat with others. People are assigned a unique name (the word "Unnamed" followed by an integer) and may subsequently rename themselves to their liking. Features included are a couple of different methods of communicating - the "say" command, which just sends a standard message, and the "me" command, which is roughly equivilant to the /me command in [IRC]. I fancy this code so lucid it's almost self-documenting (thank the language for that, not me) and it serves to show a lot of the elegance of Tcl. #!/bin/sh # the next line restarts using tclsh \ exec wish "$0" ${1+"$@"} set port 1234 proc handle_connection {client_socket host port} { global client_sockets counter name2socket socket2name set client_name "Unnamed$counter" incr counter announce "$client_name has connected." lappend client_sockets $client_socket set name2socket($client_name) $client_socket set socket2name($client_socket) $client_name fconfigure $client_socket -buffering line fileevent $client_socket readable [list receive_line_from $client_socket] puts $client_socket "You are logged in as \"$client_name\". Type \"help\" to see a rundown of commands." } proc receive_line_from {client_socket} { global client_sockets name2socket socket2name if {[catch {gets $client_socket line} send_error]} { clean_up_client $client_socket announce "* $socket2name($client_socket) has disconnected \[Error outputting to client: $error\]." } elseif {[eof $client_socket]} { clean_up_client $client_socket announce "* $socket2name($client_socket) has disconnected \[Connection closed by client\]." } if {$line == ""} { puts $client_socket "You must enter some command." return } set first_character [string index $line 0] set rest [string range $line 1 end] if {$first_character == "\""} { set command_name "say" set command_data $rest } elseif {$first_character == ":"} { set command_name "emote" set command_data $rest } elseif {![regexp {^(.+?) (.*)$} $line dummy command_name command_data]} { # If the above line fails to find a command with supplied data, then set the # command name to the whole string and the data to an empty string set command_name $line set command_data "" } set client_name $socket2name($client_socket) switch -- $command_name { say { announce "$client_name says, \"$command_data\"" } me { announce "$client_name $command_data" } who { puts $client_socket "The following people are online:" puts $client_socket "------------" foreach wsocket $client_sockets { puts $client_socket $socket2name($wsocket) } puts $client_socket "------------" } name { set new_name $command_data if {$new_name == $client_name} { puts $client_socket "You already are using that name." } elseif {[string is alnum $new_name] && [string length $new_name] <= 20} { foreach wsocket $client_sockets { if {$socket2name($wsocket) == $new_name} { puts $client_socket "That name is already taken." return } } set socket2name($client_socket) $new_name unset name2socket($client_name) set name2socket($new_name) $client_socket announce "* $client_name is now known as $new_name." } else { puts $client_socket "You must pick a name which is at most 20 characters long and which consists of only alphanumeric characters and underscores." } } help { puts $client_socket "Command rundown:" puts $client_socket " say Hello (or) \"Hello" puts $client_socket " me waves (or) :waves" puts $client_socket " who" puts $client_socket " name New_Name" puts $client_socket " help" } default { puts $client_socket "Invalid command." } } } proc announce {message} { global client_sockets foreach client_socket $client_sockets { puts $client_socket $message } } proc clean_up_client {client_socket} { global name2socket socket2name client_sockets close $client_socket set pos [lsearch -exact $client_sockets $client_socket] set client_sockets [lreplace $client_sockets $pos $pos] unset name2socket($socket2name($client_socket)) socket2name($client_socket) } set client_sockets [list] array set name2socket [list] array set socket2name [list] set counter 1 if {[catch {socket -server handle_connection $port} listen_error]} { puts "Failed to listen for connections on $port: $listen_error" } else { puts "Server started on port $port!" vwait forever }