#
# $Source: /home/nlfm/Working/Zircon/Released/lib/RCS/main.tcl,v $
# $Date: 1997/03/07 13:54:18 $
# $Revision: 1.18.1.43 $
#
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)] {
	switch {} $zircon(soundcmd) {} default {
	    switch {} $snd {} default { eval exec $zircon(soundcmd) $snd &}
	}
    } {
	eval $zircon(bellcmd)
    }
}
#
proc doScroll {win what args} {eval $win yview $what $args}
#
proc setScroll {id txt win total window} {
    upvar #0 $id cdata
    if {$total > $cdata(history)} {
	incr total -$cdata(history)
	$txt delete 1.0 "1.0 + $total lines"
	set total $cdata(history)
    }
    $win set $total $window
}
#
# alter menu item states - used for oping and ircoping
#
proc setState {name pick state} {
    switch none [$name index last] {} default {
	global Ops
	foreach cmd $Ops($pick) {
	    if ![catch {set idx [$name index [trans $cmd]]}] {
		$name entryconfigure $idx -state $state
	    }
	}
    }
}
#
proc getOValue {win opt lc uc} {
    switch {} [set x [option get $win $lc $uc]] {set x [$win cget -$opt]}
    return $x
}
#
proc getTValue {win win2 opt lc uc} {
    switch {} [set x [option get ${win} $lc $uc]] {set x [$win2 cget -$opt]}
    return $x
}
#
proc setTags {this nk} {
    global TFn TFa TFg TBg TAF TAB TBl Bl
    set w [$this text]
    set x "$this,$nk"
    set ch [$this tagWindow]
    set TFn($x) [getTValue $ch $w font ${nk}Font Font]
    set TFg($x) [getTValue $ch $w foreground ${nk}Foreground Foreground]
    set TBg($x) [getTValue $ch $w background ${nk}Background Background]
    set TFa($x) [getTValue $ch $w font ${nk}ActionFont Font]
    set TAF($x) [getTValue $ch $w foreground ${nk}ActionForeground Foreground]
    set TAB($x) [getTValue $ch $w background ${nk}ActionBackground Background]
    switch {} [set TBl($x) [option get $ch ${nk}Bell Bell]] {
	if [info exists Bl($this)] { set TBl($x) $Bl($this) }
    }
}
#
#	0 white       8 yellow
#	1 black       9 lightgreen
#	2 blue       10 cyan
#	3 green      11 lightcyan
#	4 red   12 lightblue
#	5 brown      13 pink
#	6 purple     14 grey
#	7 orange     15 lightgrey
#
array set mIRCCol {
    0 #ffffff	8 #ffff00
    1 #000000	9 #80ff80
    2 #000080	10 #008080
    3 #00ff00	11 #00ffff
    4 #ff0000   12 #0000ff
    5 #808000	13 #ff00ff
    6 #800080	14 #808080
    7 #ffa500	15 #d3d3d3
}
#
proc insertText {this name text tag} {
    lappend taglist $tag
    switch -glob -- $text "*\[\002\003\007\017\026\037\]*" {
	while {[regexp \
	  "^(\[^\002\003\007\017\026\037\]*)(\[\002\003\007\017\026\037\])(.*)$" \
	  $text match m1 ch text]} {
	    $name insert end $m1 $taglist
	    switch -- $ch {
	    \002 { set spc @b@ }
	    \007 {
		    if ![$this quiet] { playBell $this $tag }
		    $name insert end { } $taglist [[$this net] beep] \
		      [concat $taglist @a@$tag] { } $taglist
		    continue
		}
	    \017 { set taglist {} ; lappend taglist $tag ; continue }
	    \026 { set spc @v@ }
	    \037 { set spc @u@ }
	    \003 {
		# colour stuff
		    global mIRCCol
		    if [regexp {^([0-9][0-9]?)(,([0-9][0-9]?))?(.*)} \
		      $text m fg bl bg text] {
		        switch {} [$this colour] continue
			set tag [newName @c@]
			switch -glob 0* $fg {set fg [string range $fg 1 end]}
			set fg [expr {$fg % 16}]
			$name tag configure $tag -foreground $mIRCCol($fg)
			lappend taglist $tag
			switch {} $bg {} default {
			    switch -glob 0* $bg {
				set bg [string range $bg 1 end]
			    }
			    set bg [expr {$bg % 16}]
			    $name tag configure $tag -background $mIRCCol($bg)
			}
		    } {
			listkill taglist @c@*
		    }
		    continue
		}
	    }
	    if {[set x [lsearch $taglist ${spc}*]] < 0} {
		lappend taglist $spc$tag
	    } {	set taglist [lreplace $taglist $x $x] }
	}
    }
    $name insert end $text $taglist
}
#
proc channelInvite {net chan args} {
   switch {} $chan return ; userInvite $net $chan
}
#
proc doNotice {net chan string} { 
    switch {} $string return
    if {![string compare nil [set cn [Channel :: find $chan $net]]] ||
	![$cn active]} {
	$net display @me "$chan>- $string"
    } {
	$cn addText @me "- $string"
	$cn configure -hpos end
    }
    $net NOTICE $chan $string
}
#
proc channelNotice {net chan args} {
    switch {} $chan return
    global ztrans
    mkEntryBox {} "Notice to $chan" {Enter your notice text:} \
      "{$ztrans(notice) {}}" "$ztrans(ok) {doNotice $net {$chan}}" \
      "$ztrans(cancel) {}"
}
#
proc channelList {net chan} { $net channelList $chan }
#
proc channelJoin {net chan args} {
    switch {} $chan return
    [Channel :: make $chan $net] sendJoin [lindex $args 0]
}
#
proc channelMonitor {net chan} { $net monitor $chan }
#
proc channelMode {net chan} {
    switch {} $chan return
    $net qSend MODE :$chan
}
#
proc channelWho {net chan} {
    switch {} $chan return
    $net qSend WHO :$chan
}
#
proc channelNames {net chan} {
    switch {} $chan {
	global ztrans
	if [warnUser $ztrans(names) {That will list *ALL* users on irc!!!}] {
	    $net q1Send NAMES
	}
    } default {
	$net qSend 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\.org$} { underInit $net }
    }
    set opStuff [list [$srv oper] [$srv operpw]]
    switch {} [set nk [lindex $opStuff 0]] {} default {
	switch {} [set pw [lindex $opStuff 1]] {
	    global ztrans
	    mkEntryBox .@opw$net {IRC Op Password} \
	      {Enter your operator password:} "{$ztrans(password) {}}" \
	      "$ztrans(ok) { doOper $net $nk }" "$ztrans(cancel) {}"
	} default {
	    $net send 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
    handleOn $net STARTUP [list [$srv host] [$srv port]]
}
#
proc irc004 {net prefix param pargs} {
    set vers [lindex $pargs 2]
    switch -glob -- $vers {
    2.9* {
	    $net configure -srvmsg 0
	    [$net control] add2.9stuff
	}
    default {
	    set ctl [[$net control] window]
	    if [info exists $ctl.cr.srvmsg] {
		catch {pack $ctl.cr.srvmsg -after $ctl.cr.wallop}
	    }
	    $net setFlag srvmsg
	    [$net control] del2.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
    } {
	switch [set x [Message :: find [set who [lindex $pargs 1]] $net]] \
	  nil {$net inform "$who is away: $param"} \
	  default {$x awayMsg $param}
    }
}
#
proc irc303 {net prefix param pargs} {
    global signInfo ztrans
    set frnd [$net finfo]
    set signons {}
    set signoffs {}
    set msg {}
    set lpar {}
    set signInfo($net) {}
    foreach who [split $param { }] {
	switch nil [set frd [Friend :: find $who $net]] continue
	lappend lpar $frd
	if {![$frd ison] || [$frd limbo]} {
	    $frd configure -ison 1 -limbo 0
 	    if [$frnd absent $frd] {
		switch nil [$frd usr] {} default { [$frd usr] heal }
	    } {
		switch {} [$frd id] {
		    lappend signons $who
		    if {[$net friendsOn] && [$frd menu]} { $frnd add $frd }
		    $frnd mark $frd ison
		} default {
		    lappend signInfo($net) $frd
		}
	    }
	}
    }
    switch {} $signons {} default {set msg "Signon by $signons detected.\n"}
    foreach frd [$net friends] {
	if {[$frd ison] && ![$frd limbo] && [lsearch $lpar $frd] < 0} {
	    switch nil [set usr [$frd usr]] {} default { $usr off }
	    $frd configure -usr nil -ison 0
	    $frnd remove $frd
	    lappend signoffs [$frd name]
	}
    }
    switch {} $signoffs {} default {
	set msg "${msg}Signoff by $signoffs detected.\n"
    }
    switch {} $msg {} default {
	set cmd "mkInfoBox $net ISON .@isn$net Notify {[getDate] :\n$msg} {$ztrans(dismiss) {}}"
	switch {} $signons {} default {
	    append cmd " {$ztrans(whois) {who303 $net $signons}}"
	}
	switch {} $signoffs {} default {
	    append cmd " {$ztrans(whowas) {was303 $net $signoffs}}"
	}
	eval $cmd
    }
    foreach x $signInfo($net) {$net qSend USERHOST :[$x name]}
}
#
proc who303 {net args} { foreach x $args { $net send WHOIS $x } }
#
proc was303 {net args} { foreach x $args { $net send WHOWAS $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]
    switch nil [set chn [Channel :: find $chan $net]] {
	$net inform "Mode for $chan : $mode"
    } default {
	$chn mode $mode
    }
}
#
proc updateMon {net chid names} {
    set w .@mon$chid
    if ![winfo exists $w] {makeMon $net $chid $names ; return}
    set win $w.users.userList
    set xist {}
    foreach n [winfo children $win] { lappend xist [winfo name $n] }
    foreach n [split [string trim $names]] {
	switch {} $n continue
	regexp {^([@+]?)(.*)} $n m mrk n
	switch $mrk {
	@ { set mrk operator} 
	+ { set mrk speaker}
	}
	set usr [User :: make $n $net]
	if ![winfo exists [set winu $win.$usr]] {
	    wsortIns nil $win $n $usr
	    $usr ref
	} {
	    if ![normal $winu] {
		$winu configure -state normal
		$usr heal
	    }
	    listkill xist $usr
	}
	markButton $winu $mrk
    }
    foreach n $xist {if [normal $win.$n] {destroy $win.$n ; $n deref}}
}
#
proc makeMon {net chid names} {
    global ztrans
    set w .@mon$chid
    toplevel $w -class Zircon
    set chan [$chid name]
    wm title $w "$chan $ztrans(monitor)"
    wm resizable $w 0 1
    wm protocol $w WM_DELETE_WINDOW "deMonitor $net $chid 1"
 
    pack [frame $w.btns -relief raised] -side bottom -fill x
    pack [set wu [frame $w.users -relief raised]] -fill y
    scrollbar $wu.vscroller -command "$wu.userList yview" 
    set win [text $wu.userList -yscrollcommand "bsSet $wu.vscroller" \
      -relief flat -borderwidth 0 -width 14 -height 10]
    pack $wu.userList $wu.vscroller -side left -fill y -expand 1
    button $w.btns.cancel -text $ztrans(dismiss) \
      -command "deMonitor $net $chid 1" -width 5
    button $w.btns.join -text $ztrans(join) \
      -command " $chid sendJoin {} " -width 5
    pack $w.btns.cancel $w.btns.join -side left -fill x -expand 1
    foreach n $names {
	regexp {^([@+]?)(.*)} $n m mrk n
	switch $mrk {
	@ { set mrk operator} 
	+ { set mrk speaker}
	}
	set usr [User :: make $n $net]
	set winu $win.$usr
	if ![winfo exists $winu] {
	    wsortIns nil $win $n $usr
	    $usr ref
	    markButton $winu $mrk
	}
    }
}
#
proc irc353 {net prefix param pargs} {
    global namesTxt
    append namesTxt($net) " [string trim $param]"
}
#
proc irc366 {net prefix param pargs} {
    global namesTxt ztrans
    if ![info exists namesTxt($net)] {
	set names {}
    } {
	set names [string trim $namesTxt($net)]
	unset namesTxt($net)
    }
    set chan [lindex $pargs 1] 
    switch nil [set chid [Channel :: find $chan $net]] {
	mkInfoBox $net NAMES .@names$chid "$ztrans(names) $chan" $names
    } default {
	if [$chid active] { $chid doNames [split $names]} \
	elseif {[listmember [$net monitorlst] [$chid lname]]} {
	    updateMon $net $chid [split $names]
	} {
	    mkInfoBox $net NAMES .@names$chid "$ztrans(names) $chan" $names
	}
    }
}
#
proc irc376 {net prefix param pargs} {
    if [$net motdSeen] return
    global zircon defMsg
    $net setFlag invisible
    $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]} { channelMonitor $net [$id name] }
	    }
	}
	foreach id [$net messages] {
	    switch $id $defMsg($net) {} default {
		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} {
    switch 1 $nm {return "is 1 $msg"} default {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} {
    set nm [lindex $pargs 1]
    $net inform "[string range $prefix 1 end]: There [isAre $nm {unknown connection}]."
}
#
proc irc254 {net prefix param pargs} {
    set nm [lindex $pargs 1]
    $net inform \
      "[string range $prefix 1 end]: There [isAre $nm channel] formed."
}
#
proc irc255 {net prefix param pargs} {
    $net inform "[string range $prefix 1 end]: $param"
}
#
proc zUnknown {args} {
    set cmd [lindex $args 0]
    switch -glob $cmd irc* {
	set net [lindex $args 1]
	if [$net startup] {$net fast}
	if ![auto_load $cmd] { ircNUM $net $cmd $args } { return [uplevel $args] }
    } default {
	return [uplevel sys_unknown $args]
    }
}
#
proc deMonitor {net chid dflag} {
    set w .@mon$chid
    catch {
	foreach x [winfo children $w.users.userList] {
	    catch {[winfo name $x] deref}
	}
	destroy $w
    }
    $net deMonitor [$chid lname]
    $chid configure -monitor 0
    if {$dflag && ![$chid keep] && ![$chid active]} { $chid delete }
}
#
proc find {name args} {
    switch {} [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
    catch {set text $ztrans([string tolower $text])}
    return $text
}
#
rename unknown sys_unknown
rename zUnknown unknown
