#
# $Source: /home/nlfm/Working/Zircon/Released/lib/RCS/Ignore.tcl,v $
# $Date: 1998/05/22 12:53:12 $
# $Revision: 1.18.1.10 $
#
package provide zircon 1.18
#
proc ignore {pattern args} {
    global currentNet
    set pattern [string tolower $pattern]
    if {[llength $args] > 1} {
	set opt $args
    } {
	set opt [lindex $args 0]
# fix up earlier buggyrc saving
	while {[regexp {^{(.*)}$} $opt m opt]} {
	}
    }
    set lst [list $pattern $opt]
    set ignores [$currentNet ignores]
    if {[set x [listmatch $ignores $pattern]] >= 0} {
	listupdate ignores $x $lst
    } {
	lappend ignores $lst
    }
    $currentNet configure -ignores $ignores
}
#
# Look and see if there are any ignores for this nick/name. List has format:
#	{{pattern {list of what}} ......}
#
proc z_ignore {usr nm} {
    set nm [string tolower $nm]
    set nk [$usr lname]
    foreach ig [[$usr net] ignores] {
	if {[string match [lindex $ig 0] $nk!$nm]} { return [lindex $ig 1] }
    }
    return {}
}
#
proc ignoreSet {lst what} { return [expr {[lsearch $lst $what] >= 0}] }
#
proc ignoreFlag {lst what} {
    foreach {nk v} $lst break 
    if {[set x [lsearch $v $what]] < 0} {
	return [list $nk [lappend v $what]]
    }
    return [list $nk [listdel v $x]]
}
#
proc flipIgnore {usr what} {
    set nk [$usr lname]
    set net [$usr net]
    set ignores [$net ignores]
    if {[set x [listmatch $ignores $nk!*@*]] < 0} {
	lappend ignores [ignoreFlag [list $nk!*@* {}] $what]
    } {
	listupdate ignores $x [ignoreFlag [lindex $ignores $x] $what]
    }
    $net configure -ignores $ignores +confChange Ignores
}
#
proc ignoreAll {usr} {
    global zircon IFlag
    set lst [z_ignore $usr *@*]
    foreach lx [string tolower $zircon(ignore)] {
	if {![ignoreSet $lst $lx]} {
	    flipIgnore $usr $lx
	    set IFlag($usr,$lx) 1
	}
    }
}
#
proc ignoreRemove {net ptn} {
    set ign {}
    foreach x [$net ignores] {
        switch -- $ptn [lindex $x 0] {} default { lappend ign $x }
    }
    $net configure -ignores $ign +confChange Ignores
}
#
proc ignoreClear {usr} {
    global zircon IFlag
    foreach x [string tolower $zircon(ignore)] { set IFlag($usr,$x) 0}
    set net [$usr net]
    set nk [$usr name]
    switch {} [set nm [$usr id]] { set nm *@* }
    set lst [$net ignores]
    set i 0
    foreach ig [$net ignores] {
	if {[string match [lindex $ig 0] $nk!$nm]} {
	    listdel lst $i
	    $net configure -ignores $lst +confChange Ignores
	    break
	}
	incr i
    }
    return {}
}
#
proc addIgnoreMenu {win usr} {
    switch nil $usr return
    $win add cascade -label [trans ignore] -menu $win.ignore
    menu $win.ignore
    global zircon IFlag
    $win.ignore add command -label [trans all] -command "ignoreAll $usr"
    $win.ignore add command -label [trans clear] -command "ignoreClear $usr"
    set lst [z_ignore $usr *@*]
    foreach x $zircon(ignore) {
	set lx [string tolower $x]
	$win.ignore add checkbutton -label $x -variable IFlag($usr,$lx) \
	  -command "flipIgnore $usr $lx"
	set IFlag($usr,$lx) [ignoreSet $lst $lx]
    }
}