# filters.tcl --
#
#       Obsolete jabberd 1.4 mod_filter (which has never been documented in
#       any XEP) support.

package require msgcat

namespace eval filters {
    ::msgcat::mcload [file join [file dirname [info script]] msgs]

    if {![::plugins::is_registered filters]} {
        ::plugins::register filters \
                            -namespace [namespace current] \
                            -source [info script] \
                            -description [::msgcat::mc "Whether the Jabberd\
                                                        1.4 mod_filter plugin\
                                                        (obsolete) is\
                                                        loaded."] \
                            -loadcommand [namespace code load] \
                            -unloadcommand [namespace code unload]
        return
    }

    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)
}

proc filters::load {} {
    hook::add finload_hook [namespace current]::setup_menu

    if {![catch {.mainframe getmenu privacy}]} {
        setup_menu
    }
}

proc filters::unload {} {
    hook::remove finload_hook [namespace current]::setup_menu

    destroy_menu

    if {[winfo exists .rulecondmenu]} {
        destroy .rulecondmenu
    }

    if {[winfo exists .ruleactmenu]} {
        destroy .ruleactmenu
    }

    foreach var [info vars [namespace current]::*] {
        unset $var
    }
}

proc filters::setup_menu {args} {
    set mlabel [::msgcat::mc "Edit message filters"]

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

    if {![info exists idx]} {
        $m add separator
        $m add command -label $mlabel -command [namespace code open]
        return
    }
}

proc filters::destroy_menu {args} {
    set mlabel [::msgcat::mc "Edit message filters"]

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

    if {[info exists idx]} {
        $m delete [expr {$idx - 1}] $idx
        return
    }
}

proc filters::open {} {
    variable rf

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

    set xlib [lindex [connections] 0]

    ::xmpp::sendIQ $xlib get \
        -query [::xmpp::xml::create item -xmlns jabber:iq:filter] \
        -command [list [namespace current]::recv]
}


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

    debugmsg filters "$res $child"

    if {![string equal $res ok]} {
        MessageDlg .filters_err \
                   -aspect 50000 \
                   -icon error \
                   -message [::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"] \
           -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 [list [namespace current]::add]
    $bb add -text [::msgcat::mc "Edit"] \
            -command [list [namespace current]::edit]
    $bb add -text [::msgcat::mc "Remove"] \
            -command [list [namespace current]::remove]
    $bb add -text [::msgcat::mc "Move up"] \
            -command [list [namespace current]::move -1]
    $bb add -text [::msgcat::mc "Move down"] \
            -command [list [namespace current]::move 1]
    pack $bb -side top

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

    .filters add -text [::msgcat::mc "OK"] \
                 -command [list [namespace current]::commit]
    .filters add -text [::msgcat::mc "Cancel"] -command {destroy .filters}

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

    ::xmpp::xml::split $child tag xmlns attrs cdata subels

    if {[string equal $xmlns jabber:iq:filter]} {
        foreach child $subels {
            process_rule $child
        }
    }
    $rf selection set 0

    .filters draw
}

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

    ::xmpp::xml::split $child tag xmlns attrs cdata subels

    set rname [::xmpp::xml::getAttr $attrs name]
    $rf insert end $rname
    lappend rulelist $rname

    foreach data $subels {
        process_rule_data $rname $data
    }
}

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

    ::xmpp::xml::split $child tag xmlns attrs cdata subels

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

proc filters::edit {} {
    variable rf

    set idx [lindex [$rf curselection] 0]
    if {$idx eq ""} return

    set name [$rf get $idx]
    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"] \
              -anchor e \
              -modal none \
              -default 0 \
              -cancel 1

    set f [$w getframe]

    Label $f.lrname -text [::msgcat::mc "Rule Name:"]
    Entry $f.rname -textvariable [namespace current]::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 [Labelframe $f.cond -text [::msgcat::mc "Condition"]]
    set fc $cond

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

    set swc [ScrolledWindow $fc.sw]
    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 -pady 1m

    set act [Labelframe $f.act -text [::msgcat::mc "Action"]]
    set fa $act

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

    set swa [ScrolledWindow $fa.sw]
    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 -pady 1m


    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 [namespace current]::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 [namespace current]::insert_item \
                      $fcond unavailable "" $rulecondmenu]
    $fa.add configure \
        -command [list [namespace current]::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 {$tag in $condtags} {
            debugmsg filters "C $tag $value"
            insert_item $fcond $tag $value $rulecondmenu
        } elseif {$tag in $acttags} {
            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 [lindex $items($f) end]
        incr n
    } 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 [namespace current]::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 && $newname in $rulelist} {
        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 idx [lindex [$rf curselection] 0]
    if {$idx eq ""} return

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

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

    set result {}
    foreach rname $rulelist {
        set rtags {}
        foreach {tag val} $rule($rname) {
            lappend rtags [::xmpp::xml::create $tag -cdata $val]
        }

        lappend result [::xmpp::xml::create rule \
                            -attrs [list name $rname] \
                            -subelements $rtags]
    }

    debugmsg filters $result

    set xlib [lindex [connections] 0]

    ::xmpp::sendIQ $xlib set \
            -query [::xmpp::xml::create item \
                            -xmlns jabber:iq:filter \
                            -subelements $result]
    destroy .filters
}

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

    set idx [lindex [$rf curselection] 0]
    if {$idx eq ""} return

    set name [$rf get $idx]
    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 selection set $newidx
}

# vim:ft=tcl:ts=8:sw=4:sts=4:et
