#
# $Source: /home/nlfm/Working/Zircon/Released/lib/RCS/Control.tcl,v $
# $Date: 1997/03/07 13:53:55 $
# $Revision: 1.18.1.59 $
#
#
package provide zircon 1.18
#
proc busyFlag {net} { $net configure -busy [expr ![$net busy]] }
#
proc control_configure {this args} {
    upvar #0 $this ndata
    while {![string match {} $args]} {
	set opt [lindex $args 0]
	set val [lindex $args 1]
	switch -glob -- $opt {
	default { set ndata([string range $opt 1 end]) $val }
	}
	set args [lrange $args 2 end]
    }
}
#
proc control_call {this op args} {
    upvar #0 $this cdata
    if [info exists cdata($op)] { return $cdata($op) }
    return [eval control_$op $this $args]
}
#
proc control_pickServer {this srv} { [$this net] changeServer $srv }
#
proc control_showServer {this srv args} {
    switch nil $srv return
    global ztrans
    upvar #0 $this cdata
    switch {} [set port [lindex $args 0]] {set port [lindex [$srv port] 0]}
    set cdata(port) $port
    set cdata(server) [$srv host]
    set w $cdata(window).port.menu
    $w delete 0 end
    foreach x [lsort -integer [$srv port]] {
	$w add command -label $x -command "set ${this}(port) $x"
    }
    $w add separator
    $w add command -label $ztrans(other) -command "$this askPort"
}
#
proc control_setPort {this args} {
    switch {} $args return
    upvar #0 $this cdata
    set cdata(port) [lindex $args 0]
}
#
proc control_setServer {this args} {
    switch {} $args return
    upvar #0 $this cdata
    set cdata(server) [lindex $args 0]
    set net [$this net]
    $net changeServer [Server :: make $cdata(server) $net]
}
#
proc control_askPort {this} {
    global ztrans
    mkEntryBox {} $ztrans(port) {Enter the port number you require:} \
      "{$ztrans(port) {}}" "$ztrans(ok) {$this setPort}" \
      "$ztrans(dismiss) {}"
}
#
proc control_askServer {this} {
    global ztrans
    mkEntryBox {} $ztrans(server) {Enter the server name you require:} \
      "{$ztrans(server) {}}" "$ztrans(ok) {$this setServer}" \
      "$ztrans(dismiss) {}"
}

#
proc leaveZircon {} {
    set quits 1
    foreach x [Net :: list] {
	if [$x active] { set quits [expr ($quits & [$x quit])] }
	if {[$x confChange] &&
	    [askUser SAVECONF {Save Configuration} \
	       "You have made changes to the configuration of \
		netspace \"[$x name].\"\nDo you wish to save them?"]} {
	    saveCurrent $x
	}
    }
    if $quits exit
}
#
proc control_redit {this opt} {
    [$this window].$opt configure -foreground red -activeforeground red
}
#
proc control_blackit {this opt} {
    [$this window].$opt configure -foreground black -activeforeground black
}
#
proc flagit {net opt w} {
    if [$net $opt] {$w.$opt configure -foreground red -activeforeground red }
}
#
proc addToConf {net} {
    set mn .@ctl.helpFrm.info.menu.conf
    if ![catch {$mn.nets index [$net name]}] return
    $mn.nets add cascade -label [$net name] -menu $mn.nets.$net
    menu $mn.nets.$net -tearoff 0
    $mn.nets.$net add command -label {Save Current} -command "saveCurrent $net"
    $mn.nets.$net add separator
    foreach nn {IRC People Channels Info} {
	$mn.nets.$net add command -label [trans $nn] \
	  -command "conf$nn $net"
    }
    switch {} [$net helpService] {} default {
	.@ctl.helpFrm.help.menu entryconfigure last -state normal
	set hm .@ctl.helpFrm.help.menu.help
	if ![winfo exists $hm] { menu $hm -tearoff 0 }
	.@ctl.helpFrm.help.menu.help add command -label [$net name] \
	  -command "getHelp $net" -state disabled
    }
}
#
proc MainControl {} {
    global zircon ztrans zlayout zCtl DEBUG
    set zCtl [Window .@ctl -title {Zircon Control Panel}]
    set ctl [$zCtl name]
    catch {wm geometry $ctl $zlayout(default,control)}
    wm resizable $ctl 1 1
    wm protocol .@ctl WM_DELETE_WINDOW leaveZircon
    grid columnconfigure .@ctl 0 -weight 1
    grid [set hf [frame $ctl.helpFrm -borderwidth 0]] -sticky ew
    set om [makeMB $hf.info "Zircon V$zircon(version)"]
    $om configure -tearoff 0
    $om add command -label "About Zircon" -command credits
    $om add cascade -label $ztrans(configure) -menu $om.conf
    $om add separator
    $om add command -label $ztrans(debug) -command zDBGControl \
      -state [expr {$DEBUG ? {normal} : {disabled}}]
    $om add separator
    $om add command -label $ztrans(quit) -command leaveZircon \
      -accelerator <Meta-q>
    menu $om.conf -tearoff 0
    $om.conf add cascade -label {Netspaces} -menu $om.conf.nets
    menu $om.conf.nets -tearoff 0
    $om.conf add command -label {Save Current} -command "saveCurrent {}"
    $om.conf add command -label {Save Layout} -command "saveLayout {}"
    $om.conf add command -label {Reread rc} -command reread -state disabled
    foreach x {0 1 2 3} {grid columnconfigure $hf $x -weight 1}
    netspaceMenu $hf
    set om [makeMB $hf.help Help]
    foreach x [glob -nocomplain [file join $zircon(lib) help *]] {
	set x [file tail $x]
	set nm [string tolower $x]
	$om add cascade -label $x -menu $om.$nm
	menu $om.$nm -tearoff 0 -postcommand "makeHelp $om.$nm $x"
    }
    $om add cascade -label "IRC Help Service" -state disabled -menu $om.help
    grid $hf.spaces $hf.info - $hf.help -sticky ew
    bind .@ctl <Meta-q> leaveZircon
}
#
proc Control {this args} {
    global Ops OType ztrans defChan
    set OType($this) Control
    initObj $this Control
    proc $this {args} "eval control_call $this \$args"
    upvar #0 $this cdata
    eval $this configure $args
    set net $cdata(net)
    set ctl [set cdata(window) [switchFrame .@ctl $net [$net name]]]
    foreach x {0 1 2 3} {grid columnconfigure $ctl $x -weight 1}
    $this serverFrame $ctl
#
    addSeparator $ctl -columnspan 4
#
    button $ctl.invisible -text $ztrans(invisible) -command "$net toggleFlag invisible"
    $this NNSBuild $ctl Nickname nickname [$net nicks] $net  $ctl.invisible
    set en [$this NNSBuild $ctl IRCName ircname [$net ircnames] $net -]
    bind $en <ButtonPress-3> "
	popPalette .@pp$net {} $en [$defChan($net) colour] %X %Y
    "
    bind $en <Escape> "
    "
#
    button $ctl.away -text $ztrans(away) -command "awayPanel $net"
    bind $ctl.away <2> "$net clearAway {}"

    set cdata(friends) [Friends frnd$net -control $this]
    if [$cdata(friends) menu] {
	menubutton $ctl.friends -text Friends -menu $ctl.friends.menu
	$cdata(friends) show
    } {
	button $ctl.friends -text Friends -command "$cdata(friends) show" 
	if [$net showFriends] { $ctl.friends invoke }
    }
    if [info exists Ops(user)] { $this buildUsers $net $ctl 3}
    set mn [makeMB $ctl.services Services]
    set i 5
    $mn add command -label $ztrans(exec) -command "$net exec"
    $mn add cascade -label $ztrans(script) -state disabled
    $mn add cascade -label $ztrans(plugin) -state disabled
    $mn add separator
    foreach cn [$net services] {
	$mn add cascade -label [$cn name] -menu $mn.$i
	set m [menu $mn.$i -tearoff 0]
	foreach nn [$cn ops] {$m add command -label $nn -command "$cn do $nn"}
	incr i
    }
    grid $ctl.away $ctl.users $ctl.friends $ctl.services -sticky ew
#
    addSeparator $ctl -columnspan 4
    frame $ctl.cmd -borderwidth 0 -relief flat
    set cm [makeMB $ctl.channels Channels]
    $cm add command -label $ztrans(favourites) -command "faves $net"
    $cm add separator    
    foreach cmd "Join Who List Mode Names Notice Monitor" {
	$cm add command -label [trans $cmd] \
	  -command "channel$cmd $net \[string trim \$${this}(channel)\]"
    }
    addChanCTCPMenu $cm $this
    $cm add separator
    $this setupChannels
    label $ctl.cmd.label -relief flat -text " $ztrans(channel) "
    emacsEntry $ctl.cmd.channel -relief sunken -textvariable ${this}(channel)
    pack $ctl.channels -in $ctl.cmd -side left
    pack $ctl.cmd.channel -side left -expand 1 -fill x
    grid $ctl.cmd - - - -sticky ew

    bind $ctl.cmd.channel <Return> "channelJoin $net \[$this channel\] {}"
    addToConf $net
    return $this
}
#
# Build the Nickname and Ircname entries for the control window
#
proc control_NNSBuild {this frm lbl var lst net wdw} {
    set name [string tolower $lbl]
    set mn [makeMB $frm.l$name $lbl]
    $this setupNames $name $lbl $net $lst
    emacsEntry $frm.$name -relief sunken -textvariable ${this}($name)
    bind $frm.$name <Return> "$net change$lbl \$${this}($name)"

    grid $frm.l$name $frm.$name - $wdw -sticky ew
    $frm.$name insert end [lindex $lst 0]
    $net configure -$var [lindex $lst 0]
    return $frm.$name
}
#
proc control_setupNames {this name which net lst} {
    set mn [$this window].l$name.menu
    $mn delete 0 end
    foreach x [lsort $lst] {
	$mn add command -label $x -command "$net change$which {$x}"
    }
}
#
proc control_setupChannels {this} {
    set cm [$this window].channels.menu
    set net [$this net]
    while {![catch {$cm entrycget last -label}]} {$cm delete last}
    set dfc [getDefault defChan $net]
    foreach chan [$net channels] {
	switch $dfc $chan continue
	if [$chan menu] {
	    $cm add command -label [$chan name] -command "$chan sendJoin"
	}
    }
}
#
proc reread {} {
}
#
proc faves {net} {
    if [winfo exists [set w .@faves$net]] {popup $w ; return}
    global ztrans defChan
    toplevel $w -class Zircon
    wm title $w Favourites
    wm resizable $w 0 1
    wm protocol $w WM_DELETE_WINDOW "killWindow $w"

    set win [frame $w.chans -relief raised]
    scrollbar $win.vscroller -command "$win.chList yview" 
    text $win.chList -yscrollcommand "bsSet $win.vscroller" -width 14 \
      -height 12
    bindtags $win.chList none
    pack $win.chList -side left -fill y
    button $win.ok -text $ztrans(dismiss) -command "killWindow $w"
    pack $win.ok -expand 1 -side right -fill y
    pack $w.chans -expand 1 -fill y
    set dfc [getDefault defChan $net]
    foreach chan [$net channels] {
	switch $dfc $chan continue
	if [$chan menu] {
	    set fm $win.chList.$chan
	    set cm [makeMB $fm [$chan name]]
	    $cm configure -postcommand "favecheck $cm $chan"
	    foreach cmd "Join Who Names Notice Monitor" {
		$cm add command -label $cmd \
		  -command "channel${cmd} $net [$chan name]"
	    }
	    addCTCPMenu $net $cm $chan
	    $win.chList window create end -window $fm
  	}
    }
}
#
proc favecheck {menu chan} {
    if [$chan active] {
	foreach e {4 6} { $menu entryconfigure $e -state normal }
	foreach e {1 3 5} { $menu entryconfigure $e -state disabled }
    } {
	foreach e {4 6} { $menu entryconfigure $e -state disabled }
	foreach e {1 3 5} { $menu entryconfigure $e -state normal }
    }
}
#
proc keepLeave {chan v} {
    switch {} $v return
    set net [$chan net]
    [$chan window].quit.menu add command -label "[prune $v 15]" \
      -command "$chan doLeave {$v}"
    $net configure +leaves $v -confChange 1
}
#
proc getLeave {chan} {
    global ztrans
    mkEntryBox {} Quit "Enter your new leaving message:" \
      "{$ztrans(message) {} {} palette}" "$ztrans(keep) {keepLeave $chan}" \
      "$ztrans(leave) {$chan doLeave}" "$ztrans(cancel) {}"
}
#
proc keepQuit {ctl v} {
    switch {} $v return
    set net [$ctl net]
    [$ctl window].quit.menu add command -label "[prune $v 15]" \
      -command "$net doQuit {$v}"
    $net configure +signoffs $v -confChange 1
}
#
proc getQuit {ctl} {
    global ztrans
    mkEntryBox {} Quit "Enter your new signoff message:" \
      "{$ztrans(signoff) {} {} palette}" "$ztrans(keep) {keepQuit $ctl}" \
      "$ztrans(quit) {[$ctl net] doQuit}" "$ztrans(cancel) {}"
}
#
proc control_ircItems {this state} {
    set net [$this net]
    foreach cid [$net channels] { $cid ircOp $state }
    set ctl [$this window]
    setState $ctl.servers.menu ircSrv $state
    setState $ctl.users.menu ircop $state
    switch $state {
    normal {$ctl.servers configure -fg red}
    disabled {$ctl.servers configure -fg black}
    }
}
#
set ch29 {&LOCAL &KILLS &NOTICES &ERRORS &CHANNEL &HASH &NUMERICS &SERVERS}
#
proc control_add2.9stuff {this} {
    global ztrans ch29
    set w [$this window]
    set net [$this net]
    set mn $w.servers.menu
    if [$mn cget -tearoff] { set ix 1 } { set ix 0 }
    if ![winfo exists $mn.msgs] {
	$mn insert $ix cascade -label $ztrans(messages) -menu $mn.msgs
	menu $mn.msgs -tearoff 0
	foreach cn $ch29 {
	    $mn.msgs add command -label $cn -command "channelJoin $net $cn {}"
	}
    }
    grid forget $w.srvmsg
    grid forget $w.wallops
    grid $w.wallops - -row [$this smrow] -column 2 -sticky ew
    $w.services.menu insert 5 command -label Squery -command "$net squery"
    $w.services.menu insert 6 command -label Servlist -command "$net servlist"
}
#
proc control_del2.9stuff {this} {
    global ztrans
    upvar #0 $this cdata
    set mn [$this window].servers.menu
    if [$mn cget -tearoff] { set ix 1 } { set ix 0 }
    if [winfo exists $mn.msgs] {
	$mn delete [$mn index $ztrans(messages)]
	destroy $mn.msgs
    }
    set w [ $this window]
    grid forget $w.wallops 
    grid $w.wallops -row $cdata(smrow) -column 2 -sticky ew
    grid $w.srvmsg -row $cdata(smrow) -column 3 -sticky ew
    if ![catch {set x [$w.services.menu index Squery]}] {
	$w.services.menu delete $x
	$w.services.menu delete [$w.services.menu index Servlist]
    }
}
#
proc control_undernet {this flag} {
    global ztrans
    set smn [$this window].servers.menu
    if [$smn cget -tearoff] { set st 1} { set st 0 }
    set six [indexHack $smn $ztrans(flags) $st]
    set umn [$this window].users.menu
    if $flag {
	if {$six < 0} {
	    $smn insert $st command -label $ztrans(flags) \
	      -command "underflags [$this net]"
	    $smn insert [expr $st + 2] command -label $ztrans(map) \
	      -command "[$this net] q1Send MAP"
	    $umn insert 4 command -label $ztrans(silence) \
	      -command "underSilence [$this net]"
	}
    } {
	if {$six >= 0} {
	    $smn delete $six
	    $smn delete [$umn index $ztrans(flags)]
	    $umn delete [$umn index $ztrans(silence)]
	}
    }
}
#
proc control_setupServer {this net} {
    global ztrans
    set sm [$this window].server.menu
    set sl {}
    foreach nn [$net servers] {	lappend sl [list [$nn host] $nn] }
    $sm delete 0 end
    foreach nn [lsort $sl] {
	$sm add command -label [lindex $nn 0] -command "$this pickServer [lindex $nn 1]"
    }
    $sm add separator
    $sm add command -label $ztrans(other) -command "$this askServer"
    switch nil [set srv [$net hostid]] {
	switch {} [set srv [lindex [lindex $sl 0] 1]] {set srv nil}
    }
    return $srv
}
#
proc control_open {this} {
    upvar #0 $this cdata
    $this disableOpen
    $cdata(net) startIRC [$cdata(net) hostid] $cdata(port)
}
#
proc control_serverFrame {this ctl} {
    global Ops ztrans
    addSeparator $ctl -columnspan 4
#
    set nf $ctl
    set net [$this net]
    frame $nf.rfr -borderwidth 0
    label $nf.rfr.restricted -text {RESTRICTED CONNECTION} -fg red    
    grid $nf.rfr - - - -sticky ew
    set sm [tk_optionMenu $nf.server ${this}(server) {}]
    set srv [$this setupServer $net]
    set qm [buttonmenu $nf.quit -command "$this open" \
      -text $ztrans(open) -padx 5 -highlightthickness 0]
    menu $qm.menu -tearoff 0
    $qm.menu add command -label $ztrans(new) -command "getQuit $this" 
    $qm.menu add separator
    foreach x [$net signoffs] {
	$qm.menu add command -label [prune $x 15] -command "$net doQuit {$x}"
    }
    tk_optionMenu $nf.port ${this}(port) 6667
    $nf.port configure -width 4 -highlightthickness 0
    grid $nf.server - $nf.port $nf.quit -sticky ew
    $this showServer $srv
    if [info exists Ops(server)] { $this buildServers $net $nf 1 0}
    button $nf.wallops -text Wallops -command "$net toggleFlag wallops"
    button $nf.srvmsg -text SrvMsg -command "$net toggleFlag srvmsg"
    grid $nf.servers - $nf.wallops $nf.srvmsg -sticky ew
    $this configure -smrow [expr [lindex [grid size $ctl] 1] - 1]
    grid [frame $nf.svc -borderwidth 0] - - - -sticky ew
}
#
proc control_buildServers {this net ctl row col} {
    global Ops zircon ztrans
    switch $zircon(serversStyle) {
    panel {
	    set f [switchFrame $ctl.srv $net $ztrans(servers)]
	}
    pulldown {
	    set mn [makeMB $ctl.servers "Server Information"]
	    foreach cmd $Ops(server) {
		$mn add command -label [trans $cmd] \
		  -command "serverCmd $net $cmd"
	    }
	    if [info exists Ops(ircSrv)] {
		foreach cmd $Ops(ircSrv) {
		  $mn add command -label [trans $cmd] -foreground red \
		    -activeforeground red -command "serverCmd $net $cmd"
		}
	    }
	    if ![$net ircop] { setState $ctl.servers.menu ircSrv disabled }
	}
    }
}
#
proc control_buildUsers {this net ctl row} {
    global Ops ztrans zircon
    switch $zircon(usersStyle) {
    pulldown {
	    set mn [makeMB $ctl.users Users]
	    foreach cmd $Ops(user) {
		switch -exact -- $cmd {
		DCC {
		       $mn add cascade -label $ztrans(dcc) -menu $mn.dcc
			menu $mn.dcc -tearoff 0
			foreach nn {List Send Chat Close} {
			    $mn.dcc add command -label [trans $nn] \
			      -command "usersDCC $net $nn"
			}
			$mn.dcc add cascade -label Auto -menu $mn.dcc.menu
			menu $mn.dcc.menu -tearoff 0
			$mn.dcc.menu add command -label Users \
			   -command "dccAutoUser $net"
			$mn.dcc.menu add command -label Directory \
			   -command "dccAutoDir $net" -state disabled
		    }
		CTCP { addCTCPMenu $net $mn {{}} }
		default {
			$mn add command -label [trans $cmd] \
			  -command "userCmd $net $cmd"
		    }
		}
	    }
	    if [info exists Ops(ircop)] {
		foreach cmd $Ops(ircop) {
		    $mn add command -label [trans $cmd] -foreground red \
		      -activeforeground red -command "userCmd $net $cmd"
		}
	    }
	    if ![$net ircop] { setState $ctl.users.menu ircop disabled }
	}
    }
}
#
proc control_startup {this} {
    set ctl [$this window]
    foreach x {wallops invisible srvmsg} {
	$ctl.$x configure -foreground black -activeforeground black
    }
}
#
proc nsSubMenu {m name} {
    global ztrans
    set mn [menu $m.n$name -tearoff 0]
    $mn add command -label $ztrans(load) -command "nsLoad $name 1 {}"
    $mn add command -label $ztrans(unload) -command "nsUnload $name" -state disabled
    $mn add command -label $ztrans(clone) -command "nsClone $name"
    $mn add command -label $ztrans(delete) -command "nsDelete $name"
}
#
proc addToNsM {name} {
    set m .@ctl.helpFrm.spaces.menu
    set i 0
    while {1} {
	if [catch {set nm [$m entrycget $i -label]}] break
	if {[string compare $name $nm] < 0} break
	incr i
    }
    $m insert $i cascade -label $name -menu $m.n$name
    nsSubMenu $m $name
}
#
proc delFromNsM {name} {
    set m .@ctl.helpFrm.spaces.menu
    set i 0
    while {1} {
	if [catch {set nm [$m entrycget $i -label]}] return
	switch -- $name $nm break
	incr i
    }
    destroy $m.n$name
    $m delete $i
}
#
proc netspaceMenu {w} {
    global zircon
    set pf1 {}
    set pf2 {}
    [set om [makeMB $w.spaces Netspaces]] configure -tearoff 0
    if ![file exists [set ns [file join $zircon(prefdir) netspaces]]] {
	$w.spaces configure -state disabled
    } {
	foreach x [lsort [glob -nocomplain [file join $ns *]]] { addNS $om $x }
	$om add separator
    }
}
#
proc addToNM {name} { addNS .@ctl.helpFrm.spaces.menu $name }
#
proc delFromNM {net} {
    .@ctl.helpFrm.spaces.menu delete [.@ctl.helpFrm.spaces.menu index $net]
}
#
proc setUnload {net state} {
    .@ctl.helpFrm.spaces.menu.n$net entryconfigure 1 -state $state
}
#
proc addNS {om x} {
    set fn [file tail $x]
    switch -glob -- $fn {
    *.bak - *.tmp {}
    default {
	    $om add cascade -label $fn -menu $om.n$fn
	    nsSubMenu $om $fn
	}
    }
}
#
proc control_channel {this} { upvar #0 $this cdata ; return $cdata(channel) }
#
proc control_flagState {this state} {
    set ctl [$this window]
    set net [$this net]
    switch {} [$net helpService] {} default {
	set hm .@ctl.helpFrm.help.menu.help
	set ix [$hm index [$net name]]
	$hm entryconfigure $ix -state $state
    }
    foreach x [winfo children $ctl] {
	foreach y [winfo children $x] {catch {$y configure -state $state }}
	catch {$x configure -state $state}
    }
    switch normal $state {} default {
	foreach x {server nickname lnickname ircname lircname port quit} {
	    $ctl.$x configure -state normal
	}
    }
}
#
proc control_setQuit {this txt cmd} {
    global ztrans
    catch {[$this window].quit configure -text $ztrans($txt) \
       -command $cmd -state normal}
}
#
proc control_disableOpen {this} {
    [$this window].quit configure -state disabled
}
#
proc control_flagSet {this flg val} {
    if $val {
	set cl red
    } {
	set cl black
    }
    [$this window].$flg configure -foreground $cl -activeforeground $cl
}
#
proc control_restricted {this val} {
    set net [$this net]
    if $val {
	grid [$this window].rfr.restricted -sticky ew
    } {
	grid forget [$this window].rfr.restricted
    }	
}
