#
# $Source: /home/nlfm/Working/Zircon/Released/lib/RCS/config.tcl,v $
# $Date: 2001/06/13 07:20:27 $
# $Revision: 1.18.1.41 $
#
package provide zircon 1.18
#
# Adjust configuration and rc file.
#
#
proc confInit {net which} {
    upvar #0 new$net newnet $net vnet

    array set newnet [array get vnet]
    switch $which {
    Friends {
	    global newFrd delFrd
	    set newFrd($net) {}
	    set delFrd($net) {}
	    Friend :: pack $net
	}
    Channels {
	    global newChn delChn
	    set newChn($net) {}
	    set delChn($net) {}
	    Channel :: pack $net
	}
    Messages {
	    global newMsg delMsg
	    set newMsg($net) {}
	    set delMsg($net) {}
	    Message :: pack $net
	}
    Servers {
	    global newSv delSv
	    set newSv($net) {}
	    set delSv($net) {}
	    Server :: pack $net
	}
    }
}
#
proc confCopyBack {net which} {
    global cVars zircon
    upvar #0 new$net newd
zshow $net
zshow [array get newd]
    switch $which {
    Channels {
	    global delChn
	    foreach v $delChn($net) {
		if {[$v active]} {
		} {
		    $v delete
		    uplevel #0 unset new$v
		}
	    }
	    copybackChan $net
	}
    Messages {
	    global delMsg
	    foreach v $delMsg($net) {
		if {[$v active]} {
		} {
		    $v delete
		    uplevel #0 unset new$v
		}
	    }
	    copybackMsg $net
	}
    Servers {
	    global newSv delSv
	    upvar #0 svd$net svdnet
	    confDirty $net
	    set newSv($net) {}
	    foreach v $delSv($net) {
# dont allow current server to be deleted!!
		switch -- [$net hostid] $v {
		} default {
		    $v unpack $net
		    $v delete
		}
	    }
	    set delSv($net) {}
	    Server :: unpack $net
	    if {[info exists svdnet]} {
		$net eval "Server :: select [$svdnet name]"
		unset svdnet
	    }
	}
    Friends {
	    global newFrd delFrd
	    foreach v $delFrd($net) {
		$v unpack $net
		$v delete
	    }
	    Friend :: unpack $net
	}
    Info {
    	    global Configure.Net
	    set win .@conf$net.f.chld
	    set cnt 0
	    foreach {nm y} [array get Configure.Net] {
	        switch mseconds [lindex $y 0] {
		    switch {} [lindex $y 1] continue
		    set newd($nm) [expr {[$win.ms.$cnt.entry get] * 1000}]
		    incr cnt
		}
	    }
	    set newd(listPattern) [$win.filter2.c.entry get]
	    set newd(topicPattern) [$win.filter2.t.entry get]
	}
    }
    foreach v $cVars($which) {
	switch -- [$net $v] $newd($v) {} default {
	    $net configure -$v $newd($v)
	    confDirty $net
	}
    }
    catch {unset newd}
    foreach x [$net confChange] {
	switch $which {
	Friends { $net setupUsers }
	Nicknames {
		switch {} [set ctl [$net control]] {} default {
		    $ctl setupNames nickname Nickname $net [$net nicks]
		}
	    }
	IRCNames {
		switch {} [set ctl [$net control]] {} default {
		    $ctl setupNames ircname IRCName $net [$net ircnames]
		}
	    }
	Servers {
		switch {} [set ctl [$net control]] {} default {
		    $ctl setupServer $net
		}
	    }
	Info { }
	Channels {
		switch {} [set ctl [$net control]] {} default {
		    $ctl setupChannels
		}
		global defChan
	        set df $defChan($net)
		switch {} [set inf [$net info]] {} default {
	            $inf configure -history [$df history] \
	              -scrollback [$df scrollback] -closetime [$df closetime]
		}
	    }
	}
    }
}
#
proc doCAN {net pos name win dflt val} {
    switch {} $val return
    upvar #0 new$net new
    global lbdata
    set wintmp $lbdata($win)
    set x [lsearch -exact $new($name) $val]
    set lvl $val
    set edit [expr {$pos != ([$win size] - 1)}]
    if {$x >= 0}  {
	if {$edit && [string compare $x $pos]} return
	if {$dflt} {
	    listdel wintmp $x
	    listput wintmp 0 [list $val]
	    listmove new($name) $x 0 $lvl
	}
    } {
	if {$dflt} {
	    if {$edit} { listdel new($name) $pos ; listdel wintmp $pos }
	    listput new($name) 0 $lvl
	    listput wintmp 0 [list $val]
	} {
	    if {$edit} {
		listupdate new($name) $pos $lvl
		listupdate wintmp $pos [list $val]
	    } {
		lappend new($name) $lvl
		listput wintmp $pos [list $val]
	    }
	}
    }
    set lbdata($win) $wintmp
    confDirty $net
}
#
proc confAddIt {net win y typ ltyp var} {
    global lbdata cbwstate
    set pos [$win nearest $y]
    set val [lindex [lindex $lbdata($win) $pos] 0]
    confDABtns $net
    switch *NEW* $val {
	mkEntryBox .@cadd$net "[$net name] - New $typ" "Enter the new $ltyp:" \
	  [list [list $typ {}]] [list ok "doCAN $net $pos $var $win 0"] \
	  [list default "doCAN $net $pos $var $win 1"] \
	  [list cancel {}]
    } default {
	confSelClear $win $pos
	mkEntryBox .@cadd$net "[$net name] - Edit $typ" "Edit the $ltyp:" \
	  [list [list $typ $val]] \
	  [list ok "doCAN $net $pos $var $win 0"] \
	  [list default "doCAN $net $pos $var $win 1"] \
	  [list delete "confDel $net $var $win"] \
	  [list cancel {}]
    }
    tkwait window .@cadd$net
    confRABtns $net
}
#
proc confAddNickname {net win y} {
    confAddIt $net $win $y Nickname nickname nicks
}
#
proc confAddIRCName {net win y} {
    confAddIt $net $win $y IRCname {IRC name} ircnames
}
#
proc doCAS {net sid pos win dflt hst prt ip pwd onk opw} {
    switch {} $hst return
    global lbdata
    switch {} $sid {
	global newSv
	set id [Server [newName _srvr] -host $hst -ip $ip -oper $onk -operpw \
	  $opw -passwd $pwd]
	switch {} $prt {set prt 6667}
	$id configure -port $prt
	lappend newSv($net) $id
	set last [expr {[$win index end] - 1}]
	confInsSel $win $last [list $hst $id]
	$id pack $net
	if {$dflt} { uplevel #0  "set svd$net [list $id]" }
    } default {
	set lnm [string tolower [set nm [$win get $pos]]]
	upvar #0 new$sid new
	switch -- $lnm [string tolower $hst] {} default {
	    set new(host) $hst
	    confUpdSel $win $pos [list $hst $sid]
	}
	switch {} $prt {set prt 6667}
	set new(port) $prt
	set new(ip) $ip
	set new(oper) $onk
	set new(operpw) $opw
	set new(passwd) $pwd
	if {$dflt} { uplevel #0 "set svd$net [list $sid]" }
    }
    confDirty $net
}
#
proc confDel {net var win args} {
    upvar #0 new$net newd
    global lbdata
    set wintmp $lbdata($win)
    set size [expr {[$win size] - 1}]
    set t {}
    foreach l [$win curselection] {
	switch -- $l $size break
	lappend t $l
	switch $var {
	servers {
		global newSv delSv
		set lnm [string tolower [$win get $l]]
		set id [lindex [lindex $wintmp $l] 1]
		if {[set x [lsearch $newSv($net) $id]] >= 0} {
		    $id unpack $net
		    $id delete
		    listdel newSv($net) $x
		} \
		elseif {![string compare $id [$net hostid]]} {
		    tk_dialog .@de {Delete error} \
		      {You cannot delete the active server!} warning 0 ok
		    set t [lreplace $t end end]
		} {
		    lappend delSv($net) $id
		}
	    }
	friends {
	    global newFrd delFrd
	    upvar #0 ${net}FTO newt
	    set id $newt([set lnm [string tolower [$win get $l]]])
	    if {[set x [lsearch $newFrd($net) $id]] >= 0} {
		$id unpack $net
		$id delete
		listdel newFrd($net) $x
	    } {
		lappend delFrd($net) $id
	    }
	}
	default {
		set cl [expr {[llength $t] - 1}]
		while {[set m [lindex $t $cl]] == $size} { incr cl -1 }
		set newd($var) [lreplace $newd($var) $l $m]
	    }
	}
    }
    switch {} $t {} default {
	set lbdata($win) [lreplace $wintmp [lindex $t 0] [lindex $t end]]
    }
    confDirty $net
}
#
proc confAddServer {net win y} {
    global lbdata
    set val [$win get [set pos [$win nearest $y]]]
    confDABtns $net
    switch *NEW* $val {
	mkEntryBox .@cas$net "[$net name] - New Server" {Enter the new server details:} \
	  [list [list hostname {}] [list port 6667] [list {IP Address} {}] \
	  [list {Server passwd} {}] [list {Op Nick} {}] \
	  [list {Op passwd} {}]] [list ok "doCAS $net {} $pos $win 0"] \
	  [list default "doCAS $net {} $pos $win 1"] \
	  [list cancel {}]
    } default {
	set sid [lindex [lindex $lbdata($win) $pos] 1]
	upvar #0 new$sid new
	confSelClear $win $pos
	mkEntryBox .@cas$net "[$net name] - Edit Server" {Edit the server details:} \
	  [list [list hostname $val] [list port $new(port)] [list {IP Address} $new(ip)] \
	  [list {Server passwd} $new(passwd)] \
	  [list {Op Nick} $new(oper)] [list {Op passwd} $new(operpw)]] \
	  [list ok "doCAS $net $sid $pos $win 0"] \
	  [list default "doCAS $net $sid $pos $win 1"] \
	  [list delete "confDel $net servers $win"] [list cancel {}]
    }
    tkwait window .@cas$net
    confRABtns $net
}
#
proc lbUpdate {name1 lb op} {
    global lbdata
    $lb delete 0 end
    set i -1
    foreach x $lbdata($lb) { $lb insert [incr i] [lindex $x 0] }
}
#
proc confEnt {net win var title} {
    global lbdata
    set name [string tolower $title]
    set winn $win.$name
    frame $winn -relief raised -bd 1
    set winnl $winn.list
    makeLB $winnl -relief flat
    set lbdata($winnl.l) {}
    trace variable lbdata($winnl.l) w lbUpdate
    set tmp {}
    switch $title {
    Friend {
	    foreach v [$net friends] { lappend tmp [list [$v name] $v] }
	}
    Server {
	    foreach v [$net servers] {
		if {![$v sys]} { lappend tmp [list [$v host] $v] }
	    }	
	}
    default {foreach v [$net $var] {lappend tmp [list $v]}}
    }
    lappend tmp *NEW*
    set lbdata($winnl.l) $tmp
    bind $winnl.l <Double-Button-1> "confAdd$title $net %W %y"
    bind $winnl.l <Delete> "confDel $net $var %W"
    bind $winnl.l <BackSpace> [bind $winnl.l <Delete>]
    bind $winnl.l <Control-h> [bind $winnl.l <Delete>]
    grid rowconfigure $winn 1 -weight 1
    grid columnconfigure $winn 0 -weight 1
    grid $winnl -sticky nsew
    grid columnconfigure $win 0 -weight 1
    grid rowconfigure $win 0 -weight 1
    grid $winn -sticky nsew
    bind $winn <Enter> "focus $winnl.l"
}
#
proc confNicknames {net win} {
    confInit $net Names
    confEnt $net $win nicks Nickname
}
#
proc confIRCNames {net win} {
    confInit $net Names
    confEnt $net $win ircnames IRCName
}
#
proc confServers {net win} {
    confInit $net Servers
    confEnt $net $win servers Server
}
#
proc doCAF {net pos win id ntfy unm uh} {
    switch {} $unm return
    set unm [$net trimNick $unm]
    set last [expr {[$win size] - 1}]
    switch {} $id {set id [Friend :: make $net $unm]}
    switch -- $pos $last {
	global newFrd
	$id configure -menu 1 -notify $ntfy -id $uh
	$id pack $net
	lappend newFrd($net) $id
	confInsSel $win $pos [list $unm $id]
    } default {
	upvar #0 ${net}FTO newFTO new$id newu
	set nm [$win get $pos]
	set lnm [string tolower $nm]
	set id $newFTO($lnm)
	if {[string compare $lnm [set lu [string tolower $unm]]] ||
	  [string compare $uh $newu(id)]} {
	    set newu(nick) $unm
	    set newu(lnick) $lu
	    set newu(notify) $ntfy
	    set newu(menu) 1
	    set newu(id) $uh
	    unset newFTO($lnm)
	    set newFTO($lu) $id
	    confUpdSel $win $pos [list $unm $id]
	}
    }
    confDirty $net
}
#
proc confAddFriend {net win y} {
    global lbdata
    set xval [lindex $lbdata($win) [set pos [$win nearest $y]]]
    set val [lindex $xval 0]
    confDABtns $net
    switch *NEW* $val {
	mkEntryBox .@can$net "[$net name] - [trans "new friend"]" {Enter the new friend's nickname:} \
	  [list [list nickname {}] [list {User@Host Pattern} {}]] \
	  [list ok "doCAF $net $pos $win {} 0"] \
	  [list {Notify On} "doCAF $net $pos $win {} 1"] [list cancel {}]
    } default {
	confSelClear $win $pos
	set id [lindex $xval 1]
	upvar #0 new$id newu
	set nf [$id notify]
	mkEntryBox .@can$net "[$net name] - Edit Friend" {Edit the Friend's nickname:} \
	  [list [list nickname $val] [list {User@Host Pattern} $newu(id)]] \
	  [list ok "doCAF $net $pos $win $id [expr {!$nf}]"] \
	  [list "Notify [expr {$nf ? {On} : {Off}}]" "doCAF $net $pos $win $id $nf"] \
	  [list delete "confDel $net friends $win"] [list cancel {}]
    }
    tkwait window .@can$net
    confRABtns $net
}
#
proc doCAI {net pos win val} {
    switch {} [set val [string trim [string tolower $val]]] return
    global confISel lbdata
    upvar #0 new$net new
    regexp {^([^!@]*)!?([^@]*)@?(.*)} $val m p1 p2 p3
    switch {} $p1 {set p1 *}
    switch {} $p2 {set p2 *}
    switch {} $p3 {set p3 *}
    set val $p1!$p2@$p3
    set x [listmatch $new(ignores) $val]
    if {[set edit [expr {$pos != ([$win size] -1)}]]} {
	if {$x >= 0 && $x != $pos} return
	set v [lindex $new(ignores) $pos]
	listupdate new(ignores) $pos [list $val [lindex $v 1]]
	set windata $lbdata($win)	;# tcl upvar bug workaround
	listupdate windata $pos [list $val]
	set lbdata($win) $windata
    } \
    elseif {$x < 0} {
	lappend new(ignores) [list $val {}]
	set pos [expr {[$win size] - 1}]
	confInsSel $win $pos [list $val]
	set confISel($net) $val
	setIB $net $val
    }
    confDirty $net
}
#
proc doConfIgnore {net indx} {
    global confISel
    upvar #0 new$net new
    switch {} $confISel($net) {} default {
	global confI zircon
	set dx [listmatch $new(ignores) $confISel($net)]
	set chin [lindex $new(ignores) $dx]
	set val [lindex $chin 1]
	set vdx [lsearch $val $indx]
	if {!$confI($indx)} {
	    if {$vdx >= 0} { listdel val $vdx }
	} \
	elseif {$vdx < 0} { lappend val $indx }
	if {$dx >= 0} {
	    listupdate new(ignores) $dx [list $confISel($net) $val]
	} {
	    lappend new(ignores) [list $confISel($net) $val]
	}
    }
    confDirty $net
}
#
proc confAddIgnore {net win y} {
    set val [$win get [set pos [$win nearest $y]]]
    confDABtns $net
    switch *NEW* $val {
	mkEntryBox .@ci$net "[$net name] - New ignore" {Enter the nickname/username to ignore:} \
	  [list [list nickname {}]] [list ok "doCAI $net $pos $win"] \
	  [list cancel {}]
    } default {
	confSelClear $win $pos
	mkEntryBox .@ci$net "[$net name] - Edit Nick" {Edit the nickname:} \
	  [list [list nickname $val]] [list ok "doCAI $net $pos $win"] \
	  [list delete "confDel $net ignores $win"] [list cancel {}]
    }
    tkwait window .@ci$net
    confRABtns $net
}
#
proc changeIgnore {net dbl win y} {
    global confISel
    if {[set confISel($net) [$win get [set p [$win nearest $y]]]] == "*NEW*"} {
	if {$dbl} { confAddIgnore $net $win } {
	    global zircon
	    foreach b $zircon(ignore) {
		set l [string tolower $b]
		.@conf$net.f.chld.ign2.$l configure -state disabled
	    }
	    switch {} [set s [$win curselection]] {} default {
		eval $win selection clear $s
	    }
	    set confISel($net) {}
	}
    } {
	confSelClear $win $p
	setIB $net $confISel($net)
    }
}
#
proc confInsSel {win pos val} {
    global lbdata
    set windata $lbdata($win)	;# tcl upvar bug workaround
    listput windata $pos $val
    set lbdata($win) $windata
    confSelClear $win $pos
}
#
proc confUpdSel {win pos val} {
    global lbdata
    set windata $lbdata($win)	;# tcl upvar bug workaround
    listupdate windata $pos $val
    set lbdata($win) $windata
    confSelClear $win $pos
}
#
proc confSelClear {win pos} {
    $win selection clear 0 end
    $win selection set $pos
}
#
proc setIB {net nk} {
    global zircon confI
    upvar #0 new$net new
    set modes [lindex [lindex $new(ignores) [listmatch $new(ignores) $nk]] 1]
    foreach b $zircon(ignore) {
	set lb [string tolower $b]
	set confI($lb) [expr {[lsearch $modes $lb] >= 0}]
	.@conf$net.f.chld.ign2.$lb configure -state normal
    }
}
#
proc confFriends {net win} {
    upvar #0 new$net new
    confInit $net Friends
    global confISel zircon
    set confISel($net) {}
    confEnt $net $win friends Friend
    checkbutton $win.on -text {Friends On} -variable new(friendsOn)
    checkbutton $win.sf -text {Show Friends} -variable new(showFriends)
    grid $win.friend -columnspan 2
    grid $win.on $win.sf -sticky ew
    evenGrid $win column 0 1
}
#
proc confIgnores {net win} {
    upvar #0 new$net new
    confInit $net People
    global confISel zircon
    set confISel($net) {}
    set winn1 $win.ign1
    makeLB $winn1 -relief flat
    global lbdata
    set lbdata($winn1.l) {}
    trace variable lbdata($winn1.l) w lbUpdate
    foreach v [$net ignores] { lappend tmp [lindex $v 0] }
    lappend tmp *NEW*
    set lbdata($winn1.l) $tmp
    bind $winn1.l <ButtonPress-1> "changeIgnore $net 0 %W %y"
    bind $winn1.l <Double-Button-1> "confAddIgnore $net %W %y"
    bind $winn1.l <Delete> "confDel $net ignores %W"
    bind $winn1.l <BackSpace> [bind $winn1.l <Delete>]
    bind $winn1.l <Control-h> [bind $winn1.l <Delete>]
    frame $win.ign2
    foreach v $zircon(ignore) {
	set lv [string tolower $v]
	checkbutton $win.ign2.$lv -text $v -state disabled \
	  -variable confI($lv) -command "doConfIgnore $net $lv"
	grid  $win.ign2.$lv -sticky w
    }
    grid $win.ign1 -column 0 -row 0 -sticky nsew
    grid $win.ign2 -row 0 -column 1 -sticky ns
    grid columnconfigure $win 0 -weight 1
}

