#
# $Source: /home/nlfm/Working/Zircon/Released/lib/RCS/misc.tcl,v $
# $Date: 2002/01/18 12:22:24 $
# $Revision: 1.18.1.59 $
#
package provide zircon 1.18
#
proc credits {} {
    global zircon tk_patchLevel tcl_platform
    if {[winfo exists .@abt]} {
        popup .@abt
	return
    }
    set h [winfo screenheight .]
    set w [winfo screenwidth .]
    set iw [image width advert]
    set ih [image height advert]
    makeToplevel .@abt {} {} {}
    wm overrideredirect .@abt 1
    wm resizable .@abt 0 0
    grid [frame .@abt.f -borderwidth 4 -relief raised -bg white]
    label .@abt.f.ad -relief raised -borderwidth 2 -image advert
    grid .@abt.f.ad
    grid [label .@abt.f.i1 -text "Patchlevel: $zircon(patchlevel)" \
      -fg blue -bg white]
    grid [label .@abt.f.i2 -text "Tcl: [info patchlevel] Tk: $tk_patchLevel" \
       -fg blue -bg white]
    bind .@abt.f.i1 <1> { destroy .@abt }
    bind .@abt.f.i2 <1> { destroy .@abt }
    bind .@abt.f.ad <1> { destroy .@abt }
    bind .@abt.f <1> { destroy .@abt }
    wm geometry .@abt +[expr {($w -[winfo reqwidth .@abt]) /2}]+[expr {($h - [winfo reqheight .@abt])/2}]
}
#
proc viewMode {net chan args} { $net q1Send "MODE :$chan" }
#
proc doLimit {net chan string} {
    switch 0 $string {unlimit $net $chan} default {$net MODE $chan +l $string}
}
#
proc unlimit {net chan args} { $net MODE ${chan} -l }
#
proc channel_setLimit {this} {
    set chan [$this name]
    set net [$this net]
    if {[$this operator]} {
        mkEntryBox .@l$this [trans limit] "Enter limit value for $chan:" \
          [list [list limit {}]] \
          [list set "doLimit $net $chan"] \
          [list view "viewMode $net $chan"] \
          [list clear "unlimit $net $chan"] \
          [list cancel {}]
    } {
	viewMode $net $chan
    }
}
#
proc reallyKick {net chan who msg} {$net KICK $chan $who $msg}
#
proc channel_kick {this usr} {
    set chan [$this name]
    set who [$usr name]
    mkDialog {} .@k$this [trans kick] "Really kick $who from channel $chan?" \
      [list [list message {}]] \
      [list ok "reallyKick [$this net] [list $chan] [list $who]"] \
      [list cancel {}]
}
#
proc channel_banKick {this usr} {
    global banInfo
    set banInfo([$this net]) [list [$usr ref] $this]
    [$this net] q1Send "USERHOST :[$usr name]"
}
#
proc channel_banList {this args} { [$this net] q1Send "MODE [$this name] :+b" }
#
proc doBan {net op chid string} {
    if {$string != {}} { $net q1Send "MODE [$chid name] ${op}b :$string" }
}
#
proc channel_setBan {this} {
    set net [$this net]
    if {[$this operator]} {
	mkEntryBox .@ban$this [trans ban] \
	  "Enter name to be banned/unbanned from [$this name]." \
	  [list [list pattern {}]] [list ban "doBan $net + $this"] \
	  [list unban "doBan $net - $this"] \
	  [list list "$this banList"] [list cancel {}]
    } {
	$this banList
    }
}
#
proc doKey {chid string} {
    switch {} $string {
	clearKey $chid
    } default {
	if {[askUser SETKEY {Set Key} "Really set key for channel [$chid name]?"]} {
	    doSetKey $chid $string
	}
    }
}
#
proc doSetKey {chid string} {
    switch {} [$chid key] {} default {doClearKey $chid}
    $chid configure -key $string
    [$chid net] MODE [$chid name] +k $string
}
#
proc clearKey {chid args} {
    switch {} [$chid key] return
    if {[askUser CLEARKEY {Clear Key} "Really clear key for channel [$chid name]?"]} {
	doClearKey $chid
    }
}
#
proc doClearKey {chid args} {
    [$chid net] q1Send "MODE [$chid name] -k :[$chid key]"
    $chid configure -key {}
}
#
proc channel_setKey {this} {
    set ch [$this name]
    set net [$this net]
    if {[$this operator]} {
	mkEntryBox .@k$this [trans key] "Enter key for $ch:" \
	  [list [list key [$this key]]] [list set "doKey $this"] \
	  [list view "viewMode $net [list $ch]"] \
	  [list clear "clearKey $this"] [list cancel {}]
    } {
	viewMode $net $ch
    }
}
#
proc finger {net nk} {
    switch {} $nk return
    global fingerInfo
    $net q1Send "USERHOST [set fingerInfo($net) :[$net trimNick [cleanup $nk]]]"
}
#
proc doBanKick {net who chan msg ptr} {
    $net q1Send "MODE $chan +b :$ptr"
    $net q1Send "KICK $chan $who :$msg"
}
#
proc irc302 {net prefix param pargs} {
    global banInfo fingerInfo signInfo
    if {![regexp {^([^*]*)(\*?)=([+-])([~+=^-]?)(.*)$} $param match nk op away ident uh]} {
	if {[info exists fingerInfo($net)]} {
	    set nk $fingerInfo($net)
	    unset fingerInfo($net)
	} \
	elseif {[info exists banInfo($net)]} {
	    set usr [lindex $banInfo($net) 0]
	    set nk [$usr name]
	    $usr deref
	    unset banInfo($net)
	} { set nk {} }
	tellError $net Nickerr "No such nick as $nk!"
	return
    }
    set usr [User :: make $net $nk]
    set frd [Friend :: find  $nk $net]
    if {[info exists banInfo($net)] && [lindex $banInfo($net) 0] == $usr} {
	set chan [[lindex $banInfo($net) 1] name]
	set who [$usr name]
	mkEntryBox {} Ban+Kick \
	  "Really ban and kick $who ($ident$uh) from channel $chan?" \
	  [list [list message {}] [list pattern *!*$uh]] \
	  [list ok "doBanKick $net [list $who] [list $chan]"] [list cancel {}]
	unset banInfo($net)
	$usr deref
    } \
    elseif {[info exists signInfo($net)] && [set x [lsearch $signInfo($net) $frd]] >= 0} {
	global signOns signNOns
	switch -regexp -- $uh [$frd id] {
	    $frd configure -ison 1
	    if {[$frd limbo]} {
	    	$frd configure -limbo 0
		switch nil [$frd usr] {} default { [$frd usr] heal }
	    } {
	        append signOns($net) "$nk ($ident$uh) "
	        lappend signNOns($net) $nk
	        set frnd [$net finfo]
	        if {[$net friendsOn] && [$frd menu]} { $frnd add $frd }
	        $frnd mark $frd ison
	    }
	}
        listdel signInfo($net) $x
	switch {} $signInfo($net) {
	    if {[info exists signOns($net)]} {
		mkInfoBox $net ISON {} [trans notify] \
		  "[getDate] :\nSignon by $signOns($net)" [list dismiss {}] \
		  [list whois "who303 $net [list $signNOns($net)]"] \
		  [list message "Message :: make $net [$usr name]"]
		doSignons $net $signNOns($net)
	    }
	    safeUnset signInfo($net) signNOns($net) signOns($net)
	}
    } \
    elseif {[info exists fingerInfo($net)]} {
	unset fingerInfo($net)
	regexp {^~?([^@]*)@(.*)$} $uh match user host
	if {![catch {$net connect $host 79} sock]} {
		set w .@[newName fng]
		fileevent $sock readable "handleFinger $net $sock $w"
		makeToplevel $w "Finger [$usr name]" "
		    destroy $w
		    catch {close $sock}
		" {}
		grid columnconfigure $w 0 -weight 1
		grid rowconfigure $w 0 -weight 1
		scrollbar $w.vscroller -command "$w.text yview"
		text $w.text -yscrollcommand "$w.vscroller set"
		grid $w.text -row 0 -column 0 -sticky nsew
		grid $w.vscroller -row 0 -column 1 -sticky ns
		grid [button $w.ok -text [trans dismiss] -command "
		    destroy $w
		    catch {close $sock}
		"]
		puts $sock $user@$host
	} {
	    $net errmsg "Finger Error $uh : $sock"
	}
    } {
	switch {} $op {} default {set op "(IRC Operator) "}
	switch -glob -- $away *+* {set away "Not Away"} default {set away Away}
	$net inform "$nk is $ident$uh ${op}($away)"
    }
}
#
proc handleFinger {net conn w} {
    if {[catch {gets $conn} msg] || [string match {} $msg]} {
	catch {close $conn}
    } \
    elseif {[winfo exists $w]} {
	regsub -all "\r" $msg {} msg
	$w.text insert end $msg\n
    }
}
#
proc irc311 {net prefix param pargs} {
    global whois
    set whois($net,info0) [lindex $pargs 1]
    set whois($net,info1) [lindex $pargs 2]
    set whois($net,info2) [lindex $pargs 3]
    set whois($net,info3) $param
}
#
proc irc312 {net prefix param pargs} {
    global whois
    set whois($net,info4) [lindex $pargs 2]
    set whois($net,info5) $param
}
#
proc irc313 {net prefix param pargs} { global whois ; set whois($net,ircop) 1 }
#
proc whoText {net} {
    global whois
    set txt "Name: $whois($net,info1)@$whois($net,info2)\
 ($whois($net,info3))\nServer: $whois($net,info4) ($whois($net,info5))"
    if {[info exists whois($net,away)]} {
	append txt "\nAway: $whois($net,away)"
    }
    return $txt
}
#
proc irc314 {net prefix param pargs} {
    global whois whowas
    if {[info exists whois($net,info0)]} {
	if {[info exists whowas($net)]} { append whowas($net) "\n\n" }
	append whowas($net) [whoText $net]
	foreach x [array names whois $net,*] { unset whois($x) }
    }
    irc311 $net $prefix $param $pargs
}
#
proc irc317 {net prefix param pargs} {
    global whois
    set val [lindex $pargs 2]
    switch 1 $val {set whois($net,time) "1 second"} default {
	if {$val >= 60} {
	    if {$val < 120} {
		set whois($net,time) "1 minute"
	    } {
		set whois($net,time) "[expr {$val / 60}] minutes"
	    }
	} {
	    set whois($net,time) "$val seconds"
	}
    }
}

proc max {a b} { return [expr {$a > $b ? $a : $b}] }

proc irc318 {net prefix param pargs} {
    global whois
    if {![info exists whois($net,info0)]} return
    set who $whois($net,info0)
    set txt "Name: $whois($net,info1)@$whois($net,info2) ($whois($net,info3))"
    if {[info exists whois($net,info4)]} {
        set st "Server: $whois($net,info4) ($whois($net,info5))"
    } {
	set st {}
    }
    set wd [max [string length $txt] [string length $st]]
    append txt "\n$st\n"
    if {[info exists whois($net,time)]} { append txt "Idle: $whois($net,time)\n" }
    if {[info exists whois($net,ircop)]} { append txt "$who is an IRC operator.\n" }
    if {[info exists whois($net,away)]} {
	set wd [max $wd [string length $whois($net,away)]]
	append txt "Away: $whois($net,away)\n"
    }
    set w .@[newName whos]
    catch {destroy $w}
    makeToplevel $w "WHOIS $who" {} {}
    grid [text $w.t -relief raised -height 5 -width $wd] -sticky nsew
    grid columnconfigure $w 0 -weight 1
    grid rowconfigure $w 0 -weight 1
    $w.t insert end $txt
    $w.t configure -state disabled
    grid $w.t -sticky nsew
    grid [frame $w.b -relief raised] - -sticky ew
    grid columnconfigure $w.b 0 -weight 1
    grid columnconfigure $w.b 1 -weight 1
    button $w.b.ok -text [trans dismiss] -command "destroy $w"
    button $w.b.msg -text [trans message] -command "doMsg $net [list $who]"
    grid $w.b.ok $w.b.msg -sticky ew
    if {[info exists whois($net,channels)] && \
      ![string match {} $whois($net,channels)]} {
	button $w.b.all -text [trans {join all}] \
	  -command "joinAll $net {$whois($net,channels)} ; destroy $w"
	grid $w.b.all -row 0 -column 2 -sticky ew
	grid columnconfigure $w.b 2 -weight 1
	makeLB $w.f2
	foreach chn $whois($net,channels) { $w.f2.l insert end $chn }
	bind $w.f2.l <Double-Button-1> "joinAll $net \[%W get \[%W nearest %y\]\]"
	grid $w.f2 -row 0 -column 1 -sticky nsew
    }
    foreach x [array names whois $net,*] { unset whois($x) }
}
#
proc joinAll {net arg} {
    foreach ch $arg { regsub {^[@+]} $ch {} ch ; channelJoin $net $ch }
}
#
proc irc319 {net prefix param pargs} {
    global whois ; append whois($net,channels) " $param"
}
#
proc irc369 {net prefix param pargs} {
    global whois whowas
    if {[info exists whois($net,err)]} {
	set txt "There was no such user as [set who $whois($net,err)]."
    } {
	if {[info exists whowas($net)]} {
	    set txt $whowas($net)\n\n
	} {
	    set txt {}
	}
	append txt [whoText $net]
	set who $whois($net,info0)
    }
    tellInfo $net "WHOWAS $who" $txt WHOWAS
    foreach x [array names whois $net,*] { unset whois($x) }
    catch {unset whowas($net)}
}
#
proc irc341 {net prefix param pargs} {
    switch nil [set id [Channel :: find [set chan [lindex $pargs 2]] $net]] {
	set id [$net info]
    }
    $id addText {} "*** Inviting [lindex $pargs 1] to channel ${chan}"
}
#
proc irc342 {net prefix param pargs} {
    $net inform "Summoning [lindex $pargs 1] to IRC"
}
#
proc irc315 {net prefix param pargs} {
    global whoTxt
    upvar #0 $net ndata whoTxt($net) tv
    set ndata(whohandler) [lrange $ndata(whohandler) 1 end]
    if {[info exists tv]} {
	if {[string match {.@who*} $tv] && [winfo exists $tv]} { $tv yview 0 }
	unset tv
    }
}
#
proc irc352 {net prefix param pargs} {
    upvar #0 $net ndata
    switch {} [set pp [lindex $ndata(whohandler) 0]] {
        set pp doWhoLine
    }
    eval $pp $net [list $pargs] [list $param]
}
#
proc doWhoLine {net pargs param} {
    upvar #0 whoTxt($net) tv
    set fmt "%-9s\t%-14s\t%-3s\t%s@%s (%s)\n" 
    set txt [format $fmt [lindex $pargs 1] \
      [lindex $pargs 5] [lindex $pargs 6] [lindex $pargs 2] \
      [lindex $pargs 3] $param]
    if {![info exists tv]} {
	set tv [mkInfoBox $net WHO .@[newName who] "Who [getDate]" {} "dismiss {}"]
	$tv configure -tabs {1i 2i 3i}
    }
    if {![winfo exists $tv]} return
    $tv configure -state normal
    insertText [$net info] $tv $txt {}
    $tv configure -state disabled
    set ln [lindex [split [$tv index end] .] 0]
    if {$ln < 24 && $ln > 10} { $tv configure -height $ln }
    $tv see end
}
#
proc irc367 {net prefix param pargs} {
    set chan [lindex $pargs 1]
    set ban [lindex $pargs 2]
    if {[string compare nil [set chn [Channel :: find $chan $net]]] && [$chn active]} {
	$chn addText @BAN "**> $ban is banned."
    } {
	$net display @BAN "Channel $chan bans $ban"
    }
}
#
proc irc368 {net prefix param pargs} {
    set chan [lindex $pargs 1]
    if {[string compare nil [set chn [Channel :: find $chan $net]]] && [$chn active]} {
	$chn addText @BAN "**> $param"
    } {
	$net display @BAN "Channel $chan $param"
    }
}
#
proc handleURL {net url} {
    global zircon
    if {[info exists zircon(cciport)]} {
	if {![string compare $zircon(cciport) netscape]} {
            regsub -all % $url %% url1
            regsub -all , $url1 %2c url1
	    if {[catch {exec netscape -remote openurl($url1,newwindow)}]} {
		exec netscape $url &
	    }
	} \
	else {
	    $net errmsg "CCI comms no longer supported. Sorry."
	}
    }
    if {[info exists zircon(wwwclient)]} { exec $zircon(wwwclient) $url & }
}

#
proc doExec {net where} {
    mkDialog EXEC .@e$where {Execute command} {Enter command to be executed} \
	{{Command {}}} "ok {runCmd $net $where}" "cancel {}"
}
#
proc runCmd {net where cmd} {
    switch {} $cmd return
    if {[catch {open |$cmd r} ip]} {
	tellError $net Execerr "Error executing \"$cmd\" - $ip"
    } {
	fileevent $ip readable "execOP $net $where [list $cmd] $ip"
    }
}
#
proc net_exec {this} { doExec $this [$this info] }
#
proc execOP {net where cmd fd} {
    if {[catch {gets $fd} data]} {
	tellError $net Execerr "Error executing \"$cmd\" - $data"
    } \
    elseif {[eof $fd]} {
	if {[catch {close $fd} msg]} {
	    tellError $net Execerr "Error executing \"$cmd\" - $msg"
	}
    } {
       switch $where info* {$where addText EXEC $data} default {$where send $data}
    }
}
#
proc doScript {where} {
}
#
proc findURL {win x y net} {
    set ls [$win index "@$x,$y linestart"]
    set txt [$win get $ls "@$x,$y lineend"]
    if {[regexp -nocase -indices \
      "((http|ftp)://\[^ \t\)>\",;&\]+)" \
      $txt url mt]} {
	$win tag remove sel 0.0 end
	set se [expr {[lindex $mt 1] + 1}]
	$win tag add sel "$ls +[lindex $mt 0] chars" "$ls +$se chars"
	handleURL $net [$win get sel.first sel.last]
    }
    notIdle %W
}
#
proc doHelp {net topic args} {
    switch {} [set s [lindex $args 0]] {} default {$net q1Send "PRIVMSG $s :$topic"}
}
#
proc getHelp {net} {
    switch {} [$net helpService] {
	set ents [list [list topic {zircon ?}] [list service [$net helpService]]]
    } default {
	set ents [list [list topic {zircon ?}]]
    }
    mkEntryBox .@help$net [trans help] {Enter topic on which you need help:} \
      $ents [list ok "doHelp $net"] [list cancel {}]
}
#
proc net_addMemo {net nk msg} {
    upvar #0 $net ndata
    lappend ndata(memos) [list $nk $msg]
}