#
# $Source: /home/nlfm/Working/Zircon/Released/lib/RCS/confChan.tcl,v $
# $Date: 1997/02/11 13:23:52 $
# $Revision: 1.18.1.12 $
#
package provide zircon 1.18
#
proc editChan {net pos win chan} {
    global selID
    upvar #0 new$selID($net) news
    switch {} $chan return
    switch -- [set lchan [string tolower $chan]] [$selID($net) lname] return
    $win delete $pos
    confInsSel $win $pos $chan
    set news(name) $chan
    set news(lname) $lchan
}
#
proc selectDefault {net} {
    global defChan selID
    set selID($net) $defChan($net)
    setCCB $net *DEFAULT*
}
#
proc changeChan {net dbl win y} {
    global selID defChan ztrans
    saveChan $net
    switch *NEW* [set cnm [$win get [set p [$win nearest $y]]]] {
	if $dbl {
	    set selID($net) nil
	    setCCB $net {}
	    confAddChan $net $win $p
	} {
	    incr p -1
	    confSelClear $win $p
	    selectDefault $net
	}
    } default {
	set selID($net) [Channel :: find $cnm $net]
	setCCB $net $cnm
	confSelClear $win $p
	if {$dbl && [string compare $selID($net) $defChan($net)]} {
	    confDABtns $net .@cfChannels$net
	    tkwait window [mkEntryBox {} {Edit Channel} \
	      {Edit the channel name:} "{$ztrans(channel) {$cnm}}" \
	      "$ztrans(ok) {editChan $net $p $win }" \
	      "$ztrans(delete) {confDelChan $net $win $y}" \
	      "$ztrans(cancel) {}"]
	    confRABtns $net .@cfChannels$net
	}
    }
}
#
proc setCCB {net chan args} {
    global confData confB Configure.Channel
    set w .@cfChannels$net.chan
    switch {} $chan {
	foreach wc [winfo children $w.options] {
	    switch $wc $w.options.msg {} default {$wc conf -state disabled}
	}
	foreach i {history closetime icon1 icon2 logfile key} {
	   $w.values.$i.entry conf -state disabled
	}
	foreach i {fg bg} { $w.values.$i conf -state disabled }
	return
    }
    foreach i [winfo children $w.options] {
	switch $i $w.options.msg {} default {$i conf -state normal}
    }
    foreach i [winfo children $w.values] {catch {$i.entry conf -state normal}}
    foreach i {fg bg} { $w.values.$i conf -state normal }
    set chan [Channel :: find $chan $net]
    upvar #0 new$chan new
    foreach v $confData(channel) {
	set tn [lindex $v 1]
	$w.options.$tn configure -variable new${chan}($tn)
    }
    foreach b [lindex [set Configure.Channel(msg)] 1] {
	set b [string toupper $b]
	set lb [string tolower $b]
	set confB($lb) [expr {[lsearch $new(msg) $b] < 0}]
    }
    entrySet $w.values.history.entry [$chan history]
    entrySet $w.values.closetime.entry [$chan closetime]
    set v $new(icon)
    entrySet $w.values.icon1.entry [lindex $v 0]
    entrySet $w.values.icon2.entry [lindex $v 1]
    entrySet $w.values.logfile.entry [$chan logfile]
    entrySet $w.values.key.entry [$chan key]
}
#
proc CancelCAC {net win posn args} {
    selectDefault $net
    confSelClear $win [expr [$win size] - 2]
}
#
proc doCAC {net win posn chan} {
    switch -glob -- $chan {} return {[&#+]*} {} default {set chan #$chan}
    set chid [Channel :: make $chan $net]
    upvar #0 new$chid newc
    set x $posn
    if ![array exists newc] { $chid pack new }
    if ![$chid keep] {
	set x [expr {[$win size] - 2}]
	$win insert $x $chan
	$chid configure -keep 1 -sys 0
    }
    uplevel #0 "set selID($net) $chid ; lappend newChn($net) $chid"
    set newc(keep) 1
    set newc(sys) 0
    confSelClear $win $x
    setCCB $net $chan
    confDirty $net [winfo toplevel $win]
}
#
proc confAddChan {net win posn} {
    global ztrans
    confDABtns $net .@cfChannels$net
    tkwait window [mkEntryBox {} {New Channel} {Enter the channel name:} \
      "{$ztrans(channel) {}}" "$ztrans(ok) {doCAC $net $win $posn}" \
      "$ztrans(cancel) {CancelCAC $net $win $posn}"]
    confRABtns $net .@cfChannels$net
}
#
proc confDelChan {net win y args} {
    switch {} [set dx [$win curselection]] {set dx [$win nearest y]}
    if {$dx < [expr {[$win size] - 2}]} {
	$win delete $dx
	global selID newChn delChn
	uplevel #0 unset new$selID($net)
	$selID($net) configure -keep 0
	if {[set x [lsearch $newChn($net) $selID($net)]] >= 0} {
	    listdel newChn($net) $x
	    if ![$selID($net) active] {
		$selID($net) configure -keep 0
		$selID($net) delete
	    }
	} {
	    lappend delChn($net) $selID($net)
	}
	set cnm [string tolower [$win get $dx]]
	confSelClear $win $dx
	set selID($net) [Channel :: find $cnm $net]
	setCCB $net $cnm
    }
    confDirty $net [winfo toplevel $win]
}
#
proc confChannels {net} {
    set win .@cfChannels$net
    if [winfo exists $win] { popup $win ; return }
    confInit $net Channels
    toplevel $win -class Zircon
    wm title $win "[$net name] - Channel Configuration"
    wm iconname $win Channels
    wm protocol $win WM_DELETE_WINDOW "confDismiss $net Channels"
    set winc [frame $win.chan -relief raised]
    set wincn [frame $winc.nels]
    label $wincn.label -text Channels
    makeLB $wincn.list
    global confData defChan selID Configure.Channel
    foreach c [$net channels] {
	if {[string compare $c $defChan($net)] && ![$c sys] && [$c keep]} {
	    $wincn.list.l insert end [$c name]
	}
    }
    set selID($net) $defChan($net)
    $wincn.list.l insert end *DEFAULT*
    $wincn.list.l insert end *NEW*
    confSelClear $wincn.list.l [expr {[$wincn.list.l size] - 2}]
    bind $wincn.list.l <Delete> "confDelChan $net %W %y"
    bind $wincn.list.l <BackSpace> "confDelChan $net %W %y"
    bind $wincn.list.l <Control-h> "confDelChan $net %W %y"
    bind $wincn.list.l <Button-1> "changeChan $net 0 %W %y"
    bind $wincn.list.l <Double-Button-1> "changeChan $net 1 %W %y"
    pack $wincn.label
    pack $wincn.list -expand 1 -fill both
    frame $winc.options
    foreach opt $confData(channel) {
	set tn [lindex $opt 1]
	checkbutton $winc.options.$tn -text [lindex $opt 0] \
	  -variable new$defChan($net)($tn) \
	  -command "confDirty $net .@cfChannels$net"
	pack $winc.options.$tn -anchor w
    }
    label $winc.options.msg -text Messages
    pack $winc.options.msg -anchor w
    foreach opt [lindex [set Configure.Channel(msg)] 1] {
	set val [string tolower $opt]
	checkbutton $winc.options.msg$val -text $opt \
	  -variable confB($val) -command "doConfButton $net $val"
	pack $winc.options.msg$val -anchor w
    }
    frame $winc.values
    set cd "confDirty $net $win"
    labelNumber 0 $winc.values.history {-text History -width 12} {} $cd
    labelNumber 0 $winc.values.closetime {-text {Close Time} -width 12} {} $cd
    labelEntry 0 $winc.values.icon1 {-text Icon -width 12} {} $cd
    labelEntry 0 $winc.values.icon2 {-text {Active Icon} -width 12} {} $cd
    labelEntry 0 $winc.values.logfile {-text {Log File} -width 12} {} $cd
    labelEntry 0 $winc.values.key {-text Key -width 12} {} $cd
    pack $winc.values.history $winc.values.closetime $winc.values.icon1 \
      $winc.values.icon2 $winc.values.logfile $winc.values.key -expand 1 -fill x
    pack [button $winc.values.fg -text {Foreground Colour} \
      -command "confChanFG $net $win"] -expand 1
    pack [button $winc.values.bg -text {Background Colour} \
      -command "confChanBG $net $win"] -expand 1
    pack [button $winc.values.ft -text {Font} \
      -command "confChanFt $net $win"] -expand 1
    pack $winc.nels $winc.options $winc.values -side left -expand 1 -fill both

    setCCB $net *DEFAULT*
    bind $wincn <Enter> "focus $wincn.list.l"
    confMkBtn $net $win Channels
    pack $win.chan -expand 1 -fill both
    pack $win.btn -fill x
}
switch -glob [info tclversion] {
8* {
#
proc confChanFG {net win} {
    global selID
    upvar #0 new$selID($net) news
    switch {} [set g [tk_chooseColor -parent $win]] {} default {
	set news(foreground) $g
    }
    confDirty $net $win
}
#
proc confChanBG {net win} {
    global selID
    upvar #0 new$selID($net) news
    switch {} [set g [tk_chooseColor -parent $win]] {} default {
	set news(background) $g
    }
    confDirty $net $win
}
#
proc confChanFt {net win} {
    global ztrans
    tk_dialog .@ge Unimplemented "Sorry, not implemented yet" {} 0 $ztrans(ok)
}
}
{7.[67]} {
#
proc confChanFG {net win} {
    global selID
    upvar #0 new$selID($net) news
    switch {} [set g [tk_chooseColor -parent $win]] {} default {
	set news(foreground) $g
    }
    confDirty $net $win
}
#
proc confChanBG {net win} {
    global selID
    upvar #0 new$selID($net) news
    switch {} [set g [tk_chooseColor -parent $win]] {} default {
	set news(background) $g
    }
    confDirty $net $win
}
#
proc confChanFt {net win} {
    global ztrans
    tk_dialog .@ge Unsupported \
      "Sorry, not supported with this version of tcl/tk" \
      {} 0 $ztrans(ok)
}
#
}
default {
#
proc confChanFG {net win} { confChanBG $net $win }
#
proc confChanFt {net win} { confChanBG $net $win }
#
proc confChanBG {net win} {
    global ztrans
    tk_dialog .@ge Unsupported \
      "Sorry, not supported with this version of tcl/tk" \
      {} 0 $ztrans(ok)
}
#
}
}
#
proc saveChan {net} {
    global selID
    switch nil $selID($net) return
    upvar #0 new$selID($net) new
    set w .@cfChannels$net.chan.values
    foreach e {closetime history logfile key} {
	set v [$w.$e.entry get]
	switch -- $new($e) $v {} default {set new($e) $v}
    }
    set v1 [list [$w.icon1.entry get] [$w.icon2.entry get]]
    switch {{} {}} $v1 {set v1 {}}
    switch -- $v1 $new(icon) {} default {set new(icon) $v1}
}
#
proc doConfButton {net indx} {
    global selID
    switch nil $selID($net) return
    global confB
    upvar #0 new$selID($net) new
    set vdx [lsearch $new(msg) [set v [string toupper $indx]]]
    if !$confB($indx) {
	if {$vdx < 0} { lappend new(msg) $v }
    } {
	if {$vdx >= 0} { listdel new(msg) $vdx }
    }
    confDirty $net .@cfChannels$net
}
#
proc copybackChan {net} {
    global defChan
    saveChan $net
    foreach ch [info globals newchann*] { [string range $ch 3 end] unpack new }
    confDirty $net .@cfChannels$net
}
