[MAC], 28 Jan 2003: Here is a [ck] ([curses]) based client for the [Tcl Chatroom], inspired by [TkChat]. ---- #!/bin/sh # -*- tcl -*- # # CkChat: A minimalistic Ck front end to the Tcl'ers chat # Inspired by TkChat # # Author: Michael A. Cleverly, michael@cleverly.com # # Licensed under the same terms as the Tcl core. # # \ exec cwsh "$0" ${1+"$@"} package require Tcl 8.3 package require http namespace eval ::ckchat { # Make sure we can abort Ck if something goes wrong bind . exit bind . exit # # Edit these configuration settings as needed # variable username EDIT_THIS ;# username variable password EDIT_THIS ;# password variable frequency 30 ;# refresh freq in secs variable auto_load_history_p 1 ;# load history on logon? # End of Configuration Settings if {![info exists connected]} { variable connected 0 } variable host http://mini.net variable fetch_id [after 0 "#"] variable online [list] variable recent_chatter [list] variable history variable self [file join [pwd] [info script]] variable RE set RE(log) {(?x)^( # Timestamp (?: Mon | Tue | Wed | Thu | Fri | Sat | Sun ) \s (?: Jan | Feb | Mar | Apr | May | Jun | Jul | Aug | Sep | Oct | Nov | Dec ) \s+ (?: \s[1-9] | [12]\d | 3[01] ) \s \d\d:\d\d:\d\d \s # HH:MM:SS \d\d\d\d) \s # YYYY (\d+\.\d+\.\d+\.\d+) \s # IP Address \[MSG\] \s # [MSG] ([^:]+): \s # Who (.+) # what they said } set RE(online) {]*>([^<]+)} set RE(poll) {]*>\s*(\S.+\S)\s*} set RE(
) {\s*<[Bb][Rr]>\s*} array set RE { HelpStart {(?i)^\[(.+?)\](.*)$} MultiStart {(?i)^(\S+?):(.*?)$} SectEnd {(?i)^(.*)$} Color {(?i)^(.*?)$} Message {(?i)^(\S+?):(.+?)$} Help {(?i)^\[(.+?)\](.*)$} Action {(?i)^\*\s+(\S+)\s+(.+)$} Traffic {(?i)^\s*(\S+)\s+has (entered|left) the chat$} System {(?i)^(.*)$} } } proc ::ckchat::user_interface {} { variable ui variable history # A text widget + scrollbar to act as the chat log buffer frame .buffer -border {ulcorner hline urcorner vline lrcorner llcorner} scrollbar .buffer.scroll -command {.buffer.text yview} text .buffer.text -state disabled \ -background black \ -width 78 \ -height 21 \ -takefocus 0 \ -wrap word \ -yscrollcommand {.buffer.scroll set} pack .buffer.scroll -side right -fill y pack .buffer.text -side left -fill both -expand 1 set ui(orig_scroll_bg) [.buffer.scroll cget -background] set ui(orig_scroll_abg) [.buffer.scroll cget -activebackground] set ui(alt_scroll_bg) white set ui(alt_scroll_abg) white array set tags { system {-foreground red -attributes bold} date {-foreground yellow -attributes bold -lmargin2 4} who {-foreground magenta -attributes bold} bold {-foreground white -lmargin2 4 -attributes bold} chat {-foreground white -lmargin2 4} cont {-foreground white -lmargin1 4 -lmargin2 4} tcl {-foreground green -attributes bold} } foreach tag [array names tags] { eval .buffer.text tag configure $tag $tags($tag) } # Input field for commands & messages array set history [list before {} after {}] set ui(entry) "" frame .input -border {} entry .input.entry -textvariable ::ckchat::ui(entry) -attributes bold pack .input.entry -expand 1 -fill x # Bindings for control keys on the entry widget bind .input.entry ::ckchat::user_input bind .input.entry ::ckchat::user_input bind .input.entry ::ckchat::history_up bind .input.entry ::ckchat::history_down bind .input.entry ::ckchat::buffer_page_up bind .input.entry ::ckchat::buffer_page_down bind .input.entry ::ckchat::buffer_totally_up bind .input.entry ::ckchat::buffer_totally_up bind .input.entry ::ckchat::buffer_totally_down bind .input.entry ::ckchat::buffer_totally_down # Arrange the layout of the screen & give the focus to the entry widget grid configure .buffer -column 0 -row 0 -sticky nsew grid configure .input -column 0 -row 1 -sticky ew focus .input.entry after idle [list ::ckchat::log "CkChat 1.0: /help for help" system] } proc ::ckchat::history_up {} { variable ui variable history set entry $ui(entry) if {[llength $history(before)] == 0} { if {[string equal [string trim $entry] ""]} { bell } else { set ui(entry) "" set history(after) [linsert $history(after) 0 $entry] } } else { if {![string equal $entry [lindex $history(after) 0]] && ![string equal [string trim $entry] ""]} { set history(after) [linsert $history(after) 0 $entry] } set ui(entry) [lindex $history(before) end] set history(before) [lrange $history(before) 0 end-1] } } proc ::ckchat::history_down {} { variable ui variable history set entry $ui(entry) if {[llength $history(after)] == 0} { if {[string equal [string trim $entry] ""]} { bell } else { set ui(entry) "" lappend history(before) $entry } } else { if {![string equal $entry [lindex $history(before) end]] && ![string equal [string trim $entry] ""]} { lappend history(before) $entry } set ui(entry) [lindex $history(after) 0] set history(after) [lrange $history(after) 1 end] } } proc ::ckchat::buffer_page_up {} { .buffer.text yview scroll -1 pages } proc ::ckchat::buffer_page_down {} { .buffer.text yview scroll 1 pages if {[llength [.buffer.text bbox "end - 1 char"]]} { variable ui .buffer.scroll configure -background $ui(orig_scroll_bg) .buffer.scroll configure -activebackground $ui(orig_scroll_abg) } } proc ::ckchat::buffer_totally_up {} { .buffer.text yview moveto 0 } proc ::ckchat::buffer_totally_down {} { .buffer.text yview moveto 1 if {[llength [.buffer.text bbox "end - 1 char"]]} { variable ui .buffer.scroll configure -background $ui(orig_scroll_bg) .buffer.scroll configure -activebackground $ui(orig_scroll_abg) } } proc ::ckchat::user_input {} { variable ui variable history set entry [string trim $ui(entry)] set ui(entry) "" if {[string equal $entry ""]} { return } set command /say set input $entry regexp {^(?:(/\w+) *)(.*)$} $entry => command input if {![string equal [lindex $history(before) end] $entry] && ![string equal [string trim $entry] ""]} { lappend history(before) $entry } if {[info commands ::ckchat::$command] != ""} { ::ckchat::$command $input } else { bell log "\nNo such command: $command (::ckchat::$command)" system } } proc ::ckchat::log args { variable ui set auto_scroll_p [llength [.buffer.text bbox "end - 1 char"]] .buffer.text configure -state normal -takefocus 1 eval .buffer.text insert end $args .buffer.text configure -state disabled -takefocus 0 if {$auto_scroll_p} { .buffer.text see "end - 1 char" .buffer.scroll configure -background $ui(orig_scroll_bg) .buffer.scroll configure -activebackground $ui(orig_scroll_abg) } else { .buffer.scroll configure -background $ui(alt_scroll_bg) .buffer.scroll configure -activebackground $ui(alt_scroll_abg) } } proc ::ckchat::format_date {date format} { clock format [clock scan $date] -format $format } proc ::ckchat::geturl url { if {[catch { set token [::http::geturl $url -command "#"] ::http::wait $token set html [::http::data $token] ::http::cleanup $token } problem]} { log "\nError fetching $url" system log "\n$problem" system return } return $html } proc ::ckchat::posturl {url query} { if {[catch { set query [string map [list %5f _] $query] set token [::http::geturl $url -query $query -command "#"] ::http::wait $token set html [::http::data $token] ::http::cleanup $token } problem]} { log "\nError posting $url" system log "\n$problem" system return } return $html } proc ::ckchat::poll_chat {} { variable host variable username variable password variable connected variable fetch_id variable frequency variable online variable RE variable recent_chatter after cancel $fetch_id if {!$connected} { bell log "\nCannot poll; not currently connected." system return } set query [::http::formatQuery \ action stillalive \ name $username \ password $password \ color 000000 \ updatefrequency 600 \ new_msg_on_top 0 \ ls ""] set html [posturl $host/cgi-bin/chat.cgi $query] foreach {full name} [regexp -inline -all $RE(online) $html] { lappend currently_online $name } if {[info exists currently_online]} { set online $currently_online } set query [::http::formatQuery \ action chat \ name $username \ password $password \ color 000000 \ updatefrequency 600 \ new_msg_on_top 0 \ ls ""] set html [posturl $host/cgi-bin/chat.cgi $query] if {[regexp $RE(poll) $html => conversation]} { set lines [list] regsub -all $RE(
) $conversation \x00 conversation foreach item [split $conversation \x00] { if {[string length $item]} { lappend lines $item } } set found 0 set mark 0 set end [lindex $recent_chatter end] set len [llength $recent_chatter] while {1} { set idx [lsearch -exact [lrange $lines $mark end] $end] if {$idx == -1} then break set num [expr {$mark + $idx}] set back [expr {$len - $num - 1}] set l1 [join [lrange $lines 0 $num] +] set l2 [join [lrange $recent_chatter $back end] +] set mark [incr num] if {[string equal $l1 $l2]} { set found $mark } } set lines [lrange $lines $found end] foreach line $lines { lappend recent_chatter $line } if {[llength $recent_chatter] > 500} { set history [lrange $recent_chatter end-499 end] } set in_help_p 0 set in_mesg_p 0 foreach line $lines { regexp -nocase -- $RE(Color) $line => line if {$in_help_p} { if {[regexp $RE(SectEnd) $line => text]} { lappend help_lines $text set in_help_p 0 add-help $help_name [join $help_lines "\n "] } else { lappend help_lines [string trimright $line] } } elseif {$in_mesg_p} { if {[regexp $RE(SectEnd) $line => text]} { lappend mesg_lines [string trimright $text] set in_mesg_p 0 add-message $nick [join $mesg_lines "
"] } else { lappend mesg_lines [string trimright $line] } } else { if {[regexp $RE(HelpStart) $line => name text]} { set in_help_p 1 set help_name $name set help_lines [list $text] } elseif {[regexp $RE(MultiStart) $line => name text]} { set in_mesg_p 1 set nick $name set mesg_lines [list [string trimright $text]] } elseif {[regexp $RE(Message) $line => nick text]} { add-message $nick [string trim $text] } elseif {[regexp $RE(Help) $line => name text]} { add-help $name [string trim $text] } elseif {[regexp $RE(Action) $line => nick text]} { add-action $nick $text } elseif {[regexp $RE(System) $line => text]} { if {[regexp $RE(Traffic) $line => who action]} { add-traffic $who $action } else { add-system $text } } else { # Didn't recognize $line, assume help add-help Unknown? [string trim $line] } } } } set fetch_id [after [expr {$frequency * 1000}] ::ckchat::poll_chat] } proc ::ckchat::/poll input poll_chat proc ::ckchat::/load input { variable RE variable host log "\n" system array set urls {} set html [geturl $host/tchat/logs/] foreach date [regexp -inline -all {\d{4}-\d{1,2}-\d{1,2}\.txt} $html] { foreach {yyyy mm dd} [split $date -.] break set mm [format %02d $mm] set dd [format %02d $dd] set urls($yyyy-$mm-$dd) $host/tchat/logs/$date } set counter 0 foreach date [lsort [array names urls]] { set pretty_date [format_date $date "%A, %B %e %Y"] log \n system log "Chat history from $pretty_date" system set history [string map [list \n< <] [geturl $urls($date)]] foreach line [split $history \n] { if {[regexp $RE(log) $line => time ip who message]} { add-message $who $message $time } if {([incr counter] % 25) == 0} then update } } log \n system } proc ::ckchat::decode-entities {text} { return [string map -nocase [list "<" < \ ">" > \ "&" & \ "
" \n \ "

" \n\n] $text] } proc ::ckchat::strip-html {html} { regsub -all -- {<[^>]*>} $html "" html return $html } proc ::ckchat::add-message {who message {time now}} { set message [decode-entities $message] set message [strip-html $message] set message [split $message \n] log \n chat log [format_date $time "%a %H:%M: "] date log "$who: " who log [lindex $message 0] chat foreach continued_line [lrange $message 1 end] { log $continued_line cont } } proc ::ckchat::add-system {text} { log \n chat log [format_date now "%a %H:%M: "] date log $text system } proc ::ckchat::add-traffic {who action} { log \n chat log [format_date now "%a %H:%M: "] date log $action: bold log " $who" who } proc ::ckchat::add-help {type message} { variable online set message [decode-entities $message] set message [strip-html $message] if {[lsearch -exact $online $type] != -1} { log \n chat log [format_date now "%a %H:%M: "] date log "* $type " who log "whispers: " bold log $message chat return } if {[string match "->*" $type]} { log \n chat log [format_date now "%a %H:%M: "] date log "* you " who log "whispered to " bold log "$type: " who log $message chat return } set message [split $message \n] log \n chat log [format_date now "%a %H:%M: "] date log "[string trim "$type help:"] " system log [lindex $message 0] chat foreach continued_line [lrange $message 1 end] { log $continued_line cont } } proc ::ckchat::add-action {nick text} { log \n chat log [format_date now "%a %H:%M: "] date log "* $nick " who log $text chat } proc ::ckchat::/say {input {destination ""}} { if {[string length $input] == 0} then return variable host variable username variable password set query [::http::formatQuery \ action postmsg \ name $username \ password $password \ color 000000 \ updatefrequency 600 \ new_msg_on_top 0 \ ls "" \ msg_to $destination \ msg $input] set html [posturl $host/cgi-bin/chat.cgi $query] switch -regexp -- $html { "Nick doesn't exist" { log "\nSend failed; username doesn't exist" system } "Wrong Password" { log "\nSend failed; invalid password given" system } ACTION {} default { log "\nSend appears to have failed(?)" system } } } proc ::ckchat::/me input { if {[string length $input] == 0} then return /say "/me $input" } proc ::ckchat::/msg input { if {[regexp {^\s*(\w+)\s+(.+)$} $input => destination message]} { /say $message $destination } } proc ::ckchat::/quit input exit proc ::ckchat::/exit input exit proc ::ckchat::/eval input { if {[info complete $input]} { log "\n% $input" tcl catch { eval $input } result log \n$result tcl } else { bell log "\nError: command not complete: $input" system } } proc ::ckchat::/logon input { variable host variable username variable password variable fetch_id variable connected variable auto_load_history_p regexp {^\s*(\S+)(?:\s+(\S+))?} $input => user pass if {![info exists user]} { set user $username } if {![info exists pass] || [string length $pass] == 0} { set pass $password } if {[string length $user] == 0} { log "\nCannot connect without specifying a username" system return } if {[string length $pass] == 0} { log "\nCannot connect without specifying a password for $user" system return } set query [::http::formatQuery \ action login \ name $user \ password $pass] log "\nAttempting to login to $host/cgi-bin/chat2.cgi" system set html [posturl $host/cgi-bin/chat2.cgi $query] switch -regexp -- $html { "Nick doesn't exist" { log "\nLogin failed; username doesn't exist" system } "Wrong Password" { log "\nLogin failed; invalid password given" system } stillalive { set username $user set password $pass log "\nLogin succeeded!" system set connected 1 if {[string is true -strict $auto_load_history_p]} { /load history-automatically } set fetch_id [after 0 ::ckchat::poll_chat] } default { log "\nLogin appears to have failed(?)" system } } } proc ::ckchat::/logoff input { variable host variable connected variable fetch_id after cancel $fetch_id set query [::http::formatQuery action gotourl url chat.cgi] posturl $host/cgi-bin/chat2.cgi $query if {$connected} { set connected 0 log "\nLogged off" system } else { log "\nYou aren't logged in" system } } proc ::ckchat::/who input { variable online variable connected if {$connected} { log "\n/who is currently online: " system log [join $online ", "] who } else { if {[llength $online] == 0} { log "\n/who is currently online? login first to find out..." system } else { log "\n/who was online: " system log [join $online ", "] who } } } proc ::ckchat::/reload input { variable self log "\nReloading $self ... " system catch { source $self } log "reloaded!" system } proc ::ckchat::/help input { log \n chat log "CkChat -- A minimalistic front end to the Tcl'ers Chat\n" bold log "Inspired by TkChat.\n\n" bold log "Commands:\n" chat log "/logon ?username? ?password?" cont log " (defaults in script used if not overriden)\n" bold log "/logoff\n" cont log "/who\n" cont log "/me \n" cont log "/say " cont log " (implicit if the input doesn't begin with /)\n" bold log "/poll" cont log " (poll for new messages immediately)\n" bold log "/tcl script\n" cont log "/eval script\n" cont log "/reload\n" cont } # Convenience aliases interp alias {} ::ckchat::/tcl {} ::ckchat::/eval interp alias {} ::ckchat::/login {} ::ckchat::/logon interp alias {} ::ckchat::/logout {} ::ckchat::/logoff if {[info commands .buffer] == ""} { ::ckchat::user_interface }