# # $Source: /home/nlfm/Zircon/Released/lib/RCS/main.tcl,v $ # $Date: 2002/05/09 21:20:19 $ # $Revision: 1.18.1.97 $ # package provide zircon 1.18 # proc playBell {this tag} { global zircon Bl TBl set snd $Bl($this) switch -glob -- $tag { @me {catch {set snd $TBl($this,@me)}} user* {set foo [$tag lname] ; catch {set snd $TBl($this,$foo)}} } if {[info exists zircon(soundcmd)]} { if {{} != $zircon(soundcmd) && {} != $snd} { eval exec $zircon(soundcmd) $snd & } } { eval $zircon(bellcmd) } } # # alter menu item states - used for oping and ircoping # proc setState {name pick state} { if {[winfo exists $name]} { if {{none} != [$name index last]} { global Ops foreach cmd $Ops($pick) { if {![catch {set idx [$name index [trans $cmd]]}]} { $name entryconfigure $idx -state $state } } } } } # proc doNotice {net chan string} { if {$string != {}} { if {{nil} == [set cn [Channel :: find $chan $net]] || ![$cn active]} { $net display @me "$chan>- $string" } { $cn addText @me "- $string" $cn addHist $string } $net q1Send "NOTICE $chan :$string" } } # proc channelNotice {net chan args} { if {$chan != {}} { mkEntryBox {} "Notice to $chan" {Enter your notice text:} \ [list [list notice {}]] [list ok [list doNotice $net $chan]] [list cancel {}] } } # proc channelMonitor {net chan} { switch {} $chan return $net monitor [Channel :: make $net $chan] } # proc channelList {net chan} { $net channelList $chan } # proc channelJoin {net chan args} { switch {} $chan return [Channel :: make $net $chan] sendJoin [lindex $args 0] } # proc channelMode {net chan} { switch {} $chan return $net q1Send "MODE :$chan" } # proc channelWho {net chan} { switch {} $chan return $net WHO $chan } # proc channelNames {net chan} { switch {} $chan { if {[warnUser [trans names] {That will list *ALL* users on irc!!!}]} { $net q1Send NAMES } } default { $net q1Send "NAMES :$chan" } } # # First message from the server.... # proc irc001 {net prefix param pargs} { catch {destroy .@cl$net} $net flagControl normal $net fast set nk [lindex $pargs 0] switch nil [set unk [User :: find $nk $net]] {set unk [User $nk -net $net]} $net configure -myid $unk -ircop 0 -startup 0 set me [[set myid [$net myid]] name] set srv [$net hostid] switch -regexp -- [$srv host] { {.*\.dal\.net$} { $net configure -nicksize 0 } {.*\.undernet\..*} { underInit $net } } set opStuff [list [$srv oper] [$srv operpw]] if {{} != [set nk [lindex $opStuff 0]]} { if {{} == [set pw [lindex $opStuff 1]]} { mkEntryBox .@opw$net {IRC Op Password} \ "Enter your operator password for $nk on [$srv host]:" \ [list [list password {} {} secret]] \ [list ok [list $net OPER $nk]] [list cancel {}] } { $net q1Send "OPER $nk :$pw" } } foreach x {channels messages notices} { foreach y [$net $x] { if {[$y active]} { $y addText {} "*** Reconnected as [$net nickname] at\ [clock format [clock seconds]]" } } } $net inform $param $net setupTests if {![$net noRefresh]} { $net channelList { } } handleOn $net STARTUP [list [$srv host] [$srv port]] } # proc irc004 {net prefix param pargs} { set srvmsg 1 switch -regexp -- [set vers [lindex $pargs 2]] { {^(2\.9|2.[1-9][0-9]+|[3-9]).*} { set srvmsg 0 } u.* { $net configure -undernet 1 } dal.* { } } if {$srvmsg} { set ctl [[$net control] window] if {[info exists $ctl.cr.srvmsg]} { grid $ctl.srvmsg -row [[$net control] smrow] -column 3 -sticky ew } $net setFlag srvmsg [$net control] del2.9stuff } { $net configure -srvmsg 0 [$net control] add2.9stuff } $net configure -sVersion $vers \ -sUmodes [lindex $pargs 3] -sCmodes [lindex $pargs 4] $net inform \ "[string range $prefix 1 end]: umodes available [lindex $pargs 3],\ channel modes available [lindex $pargs 4]" } # proc irc381 {net prefix param pargs} { $net configure -ircop 1 $net inform $param } # proc irc301 {net prefix param pargs} { global whois if {[info exists whois($net,info0)]} { set whois($net,away) $param } \ elseif {{nil} == [set x [Message :: find [set who [lindex $pargs 1]] $net]]} { $net inform "$who is away: $param" } { $x awayMsg $param } } # proc irc303 {net prefix param pargs} { global signInfo set frnd [$net finfo] set signons {} set signoffs {} set soffmsg {} set msg {} set lpar {} set upar {} set signInfo($net) {} set ncnt 0 foreach who [split $param { }] { if {{nil} != [set usr [User :: find $who $net]]} { lappend upar $usr } if {{nil} == [set frd [Friend :: find $who $net]]} continue lappend lpar $frd if {![$frd ison] || [$frd limbo]} { if {{} == [$frd id]} { $frd configure -ison 1 if {[$frd limbo]} { $frd configure -limbo 0 switch nil [$frd usr] {} default { [$frd usr] heal } } { incr ncnt lappend signons $who if {[$net friendsOn] && [$frd menu]} { $frnd add $frd } $frnd mark $frd ison } } { incr ncnt lappend signInfo($net) $frd } } } if {{} != $signons} {set msg "Signon by $signons detected.\n"} foreach frd [$net friends] { if {[$frd ison] && ![$frd limbo] && [lsearch $lpar $frd] < 0} { set idm {} if {{nil} != [set usr [$frd usr]]} { $usr off if {{} != [set ud [$usr id]]} {set idm " ($ud)"} } $frd configure -usr nil -ison 0 $frnd remove $frd lappend signoffs [$frd name] lappend soffmsg "[$frd name]$idm" } } $net clearMsgs $upar if {{} != $signoffs} { set msg "${msg}Signoff by $soffmsg detected.\n" } switch {} $msg {} default { set cmd "mkInfoBox $net ISON .@isn$net \[trans notify\] \"\[getDate\] :\\n\$msg\" {dismiss {}}" if {{} != $signons} { append cmd " \[list whois \[list who303 $net \$signons\]\]" if {{} == $signoffs} { if {$ncnt == 1} { append cmd " \[list message \[list Message :: make $net \[lindex \$signons 0\]\]\]" } } } if {{} != $signoffs} { append cmd " \[list whowas \[list was303 $net \$signoffs\]\]" } eval $cmd } foreach x $signInfo($net) {$net sysQ "USERHOST :[$x name]"} doSignons $net $signons } # proc doSignons {net signons} { set mems [$net memos] foreach x $signons { handleOn $net ISON $x if {[ set ix [lsearch $mems "$x *"]] >= 0} { set mm [lindex $mems $ix] $net PRIVMSG $x [lindex $mm 1] set mems [lreplace $mems $ix $ix] } } $net configure -memos $mems } # proc who303 {net args} { foreach x $args { $net q1Send "WHOIS [colonLast $x]" } } # proc was303 {net args} { foreach x $args { $net q1Send "WHOWAS [colonLast $x]" } } # proc irc305 {net prefix param pargs} { $net irc305 } # proc irc306 {net prefix param pargs} { $net irc306 } # proc irc321 {net prefix param pargs} { $net irc321 } # proc irc322 {net prefix param pargs} { $net irc322 $prefix $param $pargs } # proc irc323 {net prefix param pargs} { $net irc323 $prefix $param $pargs } # proc irc324 {net prefix param pargs} { set chan [lindex $pargs 1] set mode [lrange $pargs 2 end] if {{nil} == [set chn [Channel :: find $chan $net]]} { $net inform "Mode for $chan : $mode" } { $chn mode $mode $prefix } } # proc irc353 {net prefix param pargs} { global namesTxt append namesTxt($net) " [string trim $param]" } # proc irc366 {net prefix param pargs} { global namesTxt if {![info exists namesTxt($net)]} { set names {} } { set names [string trim $namesTxt($net)] unset namesTxt($net) } set chan [lindex $pargs 1] if {{nil} == [set chid [Channel :: find $chan $net]]} { mkInfoBox $net NAMES .@names$chid [list names $chan] $names } { $chid doNames [split $names] } } # proc irc376 {net prefix param pargs} {afterMOTD $net $prefix $param $pargs} # proc afterMOTD {net prefix param pargs} { if {[$net motdSeen]} return global zircon defMsg $net setFlag invisible if {![$net nowallop] && ![[$net hostid] nowallop]} { $net setFlag wallops } if {!$zircon(j)} { foreach id [$net channels] { switch $id [getDefault defChan $net] {} default { if {[$id join] || [$id active] } { $id slowJoin } \ elseif {[$id monitor]} { $net monitor $id } } } foreach id [$net messages] { switch $id $defMsg($net) {} default { if {[$id noshow]} continue switch nil [User :: find [$id name] $net] {} default { $id show $id flag normal } } } } $net configure -motdSeen 1 } # proc irc394 {net prefix param pargs} {} # proc irc251 {net prefix param pargs} { $net inform "[string range $prefix 1 end]: $param" } # proc isAre {nm msg} { if {1 == $nm} {return "is 1 $msg"} return "are $nm ${msg}s" } # proc irc252 {net prefix param pargs} { set nm [lindex $pargs 1] $net inform \ "[string range $prefix 1 end]: There [isAre $nm operator] online." } # proc irc253 {net prefix param pargs} { $net inform "[string range $prefix 1 end]: There [isAre [lindex $pargs 1] {unknown connection}]." } # proc irc254 {net prefix param pargs} { $net inform \ "[string range $prefix 1 end]: There [isAre [lindex $pargs 1] channel] formed." } # proc irc255 {net prefix param pargs} { $net inform "[string range $prefix 1 end]: $param" } # proc find {name args} { if {{} == [set net [lindex $args 0]]} {global currentNet ; set net $currentNet} foreach class {Channel Message Notice} { switch nil [set handle [$class :: find $name $net]] continue return $handle } return nil } # proc trans {text} { global ztrans set t [string tolower $text] if {[info exists ztrans($t)]} { return $ztrans($t) } return [capitalise $t] }