![[::html::quoteFormValue $emo]](/$::IMG($emo).gif)
"
}
proc sfrmt {msg} {
set i 0
set n 0
set hmsg ""
foreach match [regexp -inline -all -indices -- $::IMGre $msg] {
lassign $match start end
set emo [string range $msg $start $end]
append hmsg [string range $msg $i [expr {$start-1}]]
append hmsg [make_iref $emo]
set i [expr {$end+1}]
}
if { $i <= [string length $msg] } {
append hmsg [string range $msg $i end]
}
return $hmsg
}
proc hfrmt {msg} {
set i 0
set n 0
set hmsg ""
foreach match [regexp -inline -all -indices -- {(https?|ftp|news|mailto|file):([^\s:]\S*[^\]\)\s\.,!\?;:'>"])} $msg] { ;# keep emacs happy "])
if { $n % 3 == 0 } {
lassign $match start end
set url [string range $msg $start $end]
append hmsg [sfrmt [string range $msg $i [expr {$start-1}]]]
append hmsg [make_href $url]
set i [expr {$end+1}]
}
incr n
}
if { $i <= [string length $msg] } {
append hmsg [sfrmt [string range $msg $i end]]
}
return $hmsg
}
proc irc_recv {} {
gets $::fd line
string trim $line
# handle PING messages from server
if {[lindex [split $line] 0] eq "PING"} {
send "PONG [info hostname] [lindex [split $line] 1]"; return
}
if {[regexp {:([^!]*)![^ ].* +PRIVMSG ([^ :]+) +:(.*)} $line -> \
nick target msg]} {
set tag ""
if [regexp {\001ACTION(.+)\001} $msg -> msg] {set tag italic}
if [in {azbridge ijchain} $nick] {
regexp {<([^>]+)>(.+)} $msg -> nick msg
}
if {$tag eq "italic"} {
lappend ::log [::html::quoteFormValue $nick] [::html::quoteFormValue $msg] [hfrmt $msg]
} else {
lappend ::log [::html::quoteFormValue $nick] [::html::quoteFormValue $msg] [hfrmt $msg]
}
} else {
lappend ::log - [::html::quoteFormValue $line] [hfrmt $line]
}
}
proc in {list element} {expr {[lsearch -exact $list $element]>=0}}
proc post msg {
if [regexp {^/me (.+)} $msg -> action] {
foreach line [split $action \n] {send "PRIVMSG $::chan :* $::nick $line"}
} else {
foreach line [split $msg \n] {send "PRIVMSG $::chan :<$::nick> $line"}
}
}
proc send str {
puts $::fd $str; flush $::fd
}
proc answer {sock host2 port2} {
fileevent $sock readable [list serve $sock $host2 $port2]
}
proc encmap enc {string map {utf- UTF iso ISO-} $enc}
proc serve {sock host2 port2} {
fconfigure $sock -blocking 0 -encoding utf-8
gets $sock line
puts "[clock seconds] $sock $host2 $port2 $line"
if {[fblocked $sock]} return
fileevent $sock readable ""
set args ""
regexp {(/[^ ?]*)\??([^ ]*)?} $line -> tail args
if { [string match "/*.gif" $tail] || [string match "/*.ico" $tail] } {
set fnm [string range $tail 1 end]
if {[catch {set fileChannel [open $fnm RDONLY] } ]} {
puts $sock "HTTP/1.0 404 Not found\n"
puts $sock "You can not post without entering a nick name!
" hform $sock a } } else { foreach {nick post hpost} [lrange $::log end-[expr {$a(CNT)*3-1}] end] { if {$nick eq $enick} { set style my_posts } else { set style other_posts } if { $a(GR) } { puts $sock "$nick: $hpost
" } else { puts $sock "$nick: $post
" } } set a(MSG) "" hform $sock a } puts $sock close $sock } } proc hform { sock anm } { upvar $anm a puts $sock "" } proc done {inChan outChan args} { close $inChan close $outChan } proc kvsplit kv { set res "" foreach i [split $kv &] { foreach {k v} [split $i =] break lappend res $k [unescape $v] } set res } proc unescape str { set str [string map [list + { } "\\" "\\\\"] $str] regsub -all -- {%([A-Fa-f0-9][A-Fa-f0-9])} $str {\\u00\1} str set str [subst -novariable -nocommand $str] set str [encoding convertfrom utf-8 $str] string trim $str } #-- connect to IRC... set ::fd [socket $::ircserver $::ircport] fconfigure $::fd -encoding utf-8 send "NICK $::ircnick" send "USER $::ircnick 0 * :Tcl user" send "JOIN $::chan" fileevent $::fd readable irc_recv socket -server answer $webchainport puts "Server ready..." vwait forever ====== ---- RFox added flying pig logo. [jdc] sorry, lost that mod in my latest version :-( ---- !!!!!! %| [Category Example] | [Category Internet] |% !!!!!!