# $Id: filters.tcl 1038 2007-03-10 14:09:40Z sergei $
#
# Obsolete jabberd 1.4 mod_filter (which has been never documented in XEP) support.
#


namespace eval filters {
    set condtags {unavailable from resource subject body show type}
    set acttags {settype forward reply offline continue}


    set fromtag(unavailable)	[::msgcat::mc "I'm not online"]
    set fromtag(from)		[::msgcat::mc "the message is from"]
    set fromtag(resource)	[::msgcat::mc "the message is sent to"]
    set fromtag(subject)	[::msgcat::mc "the subject is"]
    set fromtag(body) 		[::msgcat::mc "the body is"]
    set fromtag(show) 		[::msgcat::mc "my status is"]
    set fromtag(type) 		[::msgcat::mc "the message type is"]
    set fromtag(settype)	[::msgcat::mc "change message type to"]
    set fromtag(forward)	[::msgcat::mc "forward message to"]
    set fromtag(reply) 		[::msgcat::mc "reply with"]
    set fromtag(offline)	[::msgcat::mc "store this message offline"]
    set fromtag(continue)	[::msgcat::mc "continue processing rules"]

    set totag($fromtag(unavailable))	unavailable
    set totag($fromtag(from))		from
    set totag($fromtag(resource))	resource
    set totag($fromtag(subject))	subject
    set totag($fromtag(body)) 		body
    set totag($fromtag(show)) 		show
    set totag($fromtag(type)) 		type
    set totag($fromtag(settype))	settype
    set totag($fromtag(forward))	forward
    set totag($fromtag(reply)) 		reply
    set totag($fromtag(offline))	offline
    set totag($fromtag(continue))	continue

    set rulecondmenu [list $fromtag(unavailable) $fromtag(from) \
			  $fromtag(resource) $fromtag(subject) $fromtag(body) \
			  $fromtag(show) $fromtag(type)]

    set ruleactmenu [list $fromtag(settype) $fromtag(forward) $fromtag(reply) \
			 $fromtag(offline) $fromtag(continue)]

    set m [menu .rulecondmenu -tearoff 0]
    $m add command -label $fromtag(unavailable)
    $m add command -label $fromtag(from)
    $m add command -label $fromtag(resource)
    $m add command -label $fromtag(subject)
    $m add command -label $fromtag(body)
    $m add command -label $fromtag(show)
    $m add command -label $fromtag(type)

    set m [menu .ruleactmenu -tearoff 0]
    $m add command -label $fromtag(settype)
    $m add command -label $fromtag(forward)
    $m add command -label $fromtag(reply)
    $m add command -label $fromtag(offline)
    $m add command -label $fromtag(continue)

    custom::defgroup Privacy [::msgcat::mc "Blocking communication options."] -group Tkabber

    custom::defvar options(enable) 0 \
	[::msgcat::mc "Enable jabberd 1.4 mod_filter support (obsolete)."] \
	-type boolean -group Privacy \
	-command [namespace code setup_menu]
}

proc filters::setup_menu {args} {
    variable options

    set mlabel [::msgcat::mc "Edit message filters"]

    set m [.mainframe getmenu privacy]
    catch { set idx [$m index $mlabel] }

    if {$options(enable) && ![info exists idx]} {
	$m add separator
	$m add command -label $mlabel -command [namespace code open]
	return
    }
	
    if {!$options(enable) && [info exists idx]} {
	$m delete [expr {$idx - 1}] $idx
	return
    }
}

hook::add finload_hook [namespace current]::filters::setup_menu

proc filters::open {} {
    variable rf

    if {[winfo exists .filters]} {
	.filters draw
	return
    }

    jlib::send_iq get \
	[jlib::wrapper:createtag item \
	     -vars {xmlns jabber:iq:filter}] \
	-connection [jlib::route ""] \
	-command [list filters::recv]
}


proc filters::recv {res child} {
    variable rf
    variable rule
    variable rulelist

    debugmsg filters "$res $child"

    if {![cequal $res OK]} {
	MessageDlg .filters_err -aspect 50000 -icon error \
	    -message [format [::msgcat::mc "Requesting filter rules: %s"] \
			  [error_to_string $child]] \
	    -type user -buttons ok -default 0 -cancel 0
	return
    }


    Dialog .filters -title [::msgcat::mc "Filters"] -separator 1 -anchor e \
	-modal none \
	-default 0 -cancel 1

    set f [.filters getframe]

    set bf [frame $f.bf]
    pack $bf -side right -anchor n

    set bb [ButtonBox $bf.bb -orient vertical -spacing 0]
    $bb add -text [::msgcat::mc "Add"] -command {filters::add}
    $bb add -text [::msgcat::mc "Edit"] -command {filters::edit}
    $bb add -text [::msgcat::mc "Remove"] -command {filters::remove}
    $bb add -text [::msgcat::mc "Move up"] -command {filters::move -1}
    $bb add -text [::msgcat::mc "Move down"] -command {filters::move 1}
    pack $bb -side top

    set sw [ScrolledWindow $f.sw]
    set rf [listbox $sw.rules]
    pack $sw -expand yes -fill both
    $sw setwidget $rf

    set ok [.filters add -text [::msgcat::mc "OK"] \
		-command {filters::commit}]
    .filters add -text [::msgcat::mc "Cancel"] -command {destroy .filters}

    $rf delete 0 end
    array unset rule
    set rulelist {}

    jlib::wrapper:splitxml $child tag vars isempty chdata children

    if {[cequal [jlib::wrapper:getattr $vars xmlns] jabber:iq:filter]} {
	foreach child $children {
	    process_rule $child
	}
    }
    $rf activate 0

    .filters draw
}

proc filters::process_rule {child} {
    variable rf
    variable rulelist

    jlib::wrapper:splitxml $child tag vars isempty chdata children

    set rname [jlib::wrapper:getattr $vars name]
    $rf insert end $rname
    lappend rulelist $rname

    foreach data $children {
	process_rule_data $rname $data
    }
}

proc filters::process_rule_data {name child} {
    variable rule

    jlib::wrapper:splitxml $child tag vars isempty chdata children

    lappend rule($name) $tag $chdata
    debugmsg filters [array get rule]
}

proc filters::edit {} {
    variable rf

    set name [$rf get active]
    debugmsg filters $name
    if {$name != ""} {
	open_edit $name
    }
}


proc filters::open_edit {rname} {
    variable rule
    variable tmp

    set w [win_id rule $rname]

    if {[winfo exists $w]} {
	focus -force $w
	return
    }

    Dialog $w -title [::msgcat::mc "Edit rule"] -separator 1 -anchor e -modal none \
	    -default 0 -cancel 1

    set f [$w getframe]

    label $f.lrname -text [::msgcat::mc "Rule Name:"]
    entry $f.rname -textvariable filters::tmp($rname,name)
    set tmp($rname,name) $rname

    grid $f.lrname -row 0 -column 0 -sticky e
    grid $f.rname  -row 0 -column 1 -sticky ew

    set cond [TitleFrame $f.cond -text [::msgcat::mc "Condition"] -borderwidth 2 -relief groove]
    set fc [$cond getframe]

    button $fc.add -text [::msgcat::mc "Add"]
    pack $fc.add -side right -anchor n

    set swc [ScrolledWindow $fc.sw -relief sunken -borderwidth $::tk_borderwidth]
    pack $swc -expand yes -fill both
    set sfc [ScrollableFrame $swc.f -height 100]
    $swc setwidget $sfc

    grid $cond -row 1 -column 0 -sticky news -columnspan 2

    set act [TitleFrame $f.act -text [::msgcat::mc "Action"] -borderwidth 2 -relief groove]
    set fa [$act getframe]

    button $fa.add -text [::msgcat::mc "Add"]
    pack $fa.add -side right -anchor n

    set swa [ScrolledWindow $fa.sw -relief sunken -borderwidth $::tk_borderwidth]
    pack $swa -expand yes -fill both
    set sfa [ScrollableFrame $swa.f -height 100]
    $swa setwidget $sfa

    grid $act -row 2 -column 0 -sticky news -columnspan 2


    grid columnconfig $f 1 -weight 1 -minsize 0
    grid rowconfig $f 1 -weight 1
    grid rowconfig $f 2 -weight 1

    set fcond [$sfc getframe]
    set fact [$sfa getframe]

    $w add -text [::msgcat::mc "OK"] -command [list filters::accept_rule $w $rname $fcond $fact]
    $w add -text [::msgcat::mc "Cancel"] -command [list destroy $w]

    variable ruleactmenu
    variable rulecondmenu
    $fc.add configure \
	-command [list filters::insert_item \
		      $fcond unavailable "" $rulecondmenu]
    $fa.add configure \
	-command [list filters::insert_item $fact settype "" $ruleactmenu]

    fill_rule $rname $fcond $fact

    $w draw
}


proc filters::fill_rule {rname fcond fact} {
    variable rule
    variable condtags
    variable acttags
    variable ruleactmenu
    variable rulecondmenu
    variable items

    set items($fcond) {}
    set items($fact) {}
    foreach {tag value} $rule($rname) {
	if {[lcontain $condtags $tag]} {
	    debugmsg filters "C $tag $value"
	    insert_item $fcond $tag $value $rulecondmenu
	} elseif {[lcontain $acttags $tag]} {
	    debugmsg filters "A $tag $value"
	    insert_item $fact $tag $value $ruleactmenu
	}
    }
}



proc filters::insert_item {f tag val menu} {
    variable items
    variable fromtag

    if {[llength $items($f)]} {
	set n [expr {[lindex $items($f) [expr {[llength $items($f)] - 1}]] + 1}]
    } else { 
	set n 0
    }

    # TODO: hiding entry for some tags
    eval [list OptionMenu $f.mb$n $f.mb$n.var] $menu
    global $f.mb$n.var
    set $f.mb$n.var $fromtag($tag)
    entry $f.e$n
    $f.e$n insert 0 $val
    Separator $f.sep$n -orient vertical
    button $f.remove$n -text [::msgcat::mc "Remove"] -command [list filters::remove_item $f $n]

    grid $f.mb$n      -row $n -column 0 -sticky ew
    grid $f.e$n       -row $n -column 1 -sticky ew
    grid $f.sep$n     -row $n -column 2 -sticky ew
    grid $f.remove$n  -row $n -column 3 -sticky ew


    lappend items($f) $n
    debugmsg filters $items($f)
}

proc filters::remove_item {f n} {
    variable items

    set idx [lsearch -exact $items($f) $n]
    set items($f) [lreplace $items($f) $idx $idx]

    eval destroy [grid slaves $f -row $n]

    debugmsg filters $items($f)
}

proc filters::accept_rule {w rname fcond fact} {
    variable items
    variable totag
    variable rule
    variable tmp
    variable rf
    variable rulelist

    set newname $tmp($rname,name)
    if {$newname == ""} {
	MessageDlg .rname_err -aspect 50000 -icon error \
	    -message [::msgcat::mc "Empty rule name"] -type user \
	    -buttons ok -default 0 -cancel 0
	return
    }
    if {$rname != $newname && [lcontain $rulelist $newname]} {
	MessageDlg .rname_err -aspect 50000 -icon error \
	    -message [::msgcat::mc "Rule name already exists"] -type user \
	    -buttons ok -default 0 -cancel 0
	return
    }


    set rule($newname) {}
    foreach n $items($fcond) {
	set tag $totag([set ::$fcond.mb$n.var])
	set val [$fcond.e$n get]
	debugmsg filters "$tag $val"
	lappend rule($newname) $tag $val
    }

    foreach n $items($fact) {
	set tag $totag([set ::$fact.mb$n.var])
	set val [$fact.e$n get]
	debugmsg filters "$tag $val"
	lappend rule($newname) $tag $val
    }

    debugmsg filters [array get rule]

    set idx [lsearch -exact $rulelist $rname]
    set rulelist [lreplace $rulelist $idx $idx $newname]

    $rf delete 0 end
    foreach r $rulelist {
	$rf insert end $r
    }


    set items($fcond) {}
    set items($fact) {}
    destroy $w
}

proc filters::add {} {
    variable rule
    set rule() {}
    open_edit ""
}

proc filters::remove {} {
    variable rf
    variable rulelist

    set name [$rf get active]
    debugmsg filters $name
    if {$name != ""} {
	set idx [lsearch -exact $rulelist $name]
	set rulelist [lreplace $rulelist $idx $idx]
	$rf delete active
	debugmsg filters $rulelist
    }
}

proc filters::commit {} {
    variable rulelist
    variable rule

    set result {}
    foreach rname $rulelist {
	set rtags {}
	foreach {tag val} $rule($rname) {
	    lappend rtags [jlib::wrapper:createtag $tag -chdata $val]
	}

	lappend result [jlib::wrapper:createtag rule \
			    -vars [list name $rname] \
			    -subtags $rtags]
    }

    debugmsg filters $result
    jlib::send_iq set \
	[jlib::wrapper:createtag item \
	     -vars {xmlns jabber:iq:filter} \
	     -subtags $result] \
	-connection [jlib::route ""] \

    destroy .filters
}

proc filters::move {shift} {
    variable rulelist
    variable rf

    set name [$rf get active]
    set idx [lsearch -exact $rulelist $name]
    set rulelist [lreplace $rulelist $idx $idx]
    set newidx [expr {$idx + $shift}]
    set rulelist [linsert $rulelist $newidx $name]

    debugmsg filters $rulelist

    $rf delete 0 end
    foreach r $rulelist {
	$rf insert end $r
    }

    $rf activate $newidx
    $rf selection set $newidx

    #set newidx [expr [$rf index active] - 1]
    #$rf move active $newidx
}