# browser.tcl --
#
#       Jabber Browser (XEP-0011) implementation for Tkabber XMPP client.
#       This XEP is deprecated, so its code has been moved to a plugin.

package require msgcat

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

    if {![::plugins::is_registered browser]} {
        ::plugins::register browser \
                            -namespace [namespace current] \
                            -source [info script] \
                            -description [::msgcat::mc "Whether the Jabber\
                                                        Browser plugin is\
                                                        loaded."] \
                            -loadcommand [namespace code load] \
                            -unloadcommand [namespace code unload]
        return
    }

    set brwid 0
    custom::defvar browse_list {} [::msgcat::mc "List of browsed JIDs."] \
            -group Hidden

    image create photo ""
}

proc browser::load {} {
    if {[winfo exists [set m .b2popmenu]]} {
        destroy $m
    }
    menu $m -tearoff 0
    $m add command -label [::msgcat::mc "Join group..."] -command {
        join_group_dialog \
           $::plugins::browser::browser(xlib,$::plugins::browser::headwindow) \
           -server [::xmpp::jid::server $::plugins::browser::headjid] \
           -group [::xmpp::jid::node $::plugins::browser::headjid]
    }
    $m add command -label [::msgcat::mc "Add conference..."] -command {
        plugins::conferences::add_conference_dialog \
           $::plugins::browser::browser(xlib,$::plugins::browser::headwindow) \
           -group [::xmpp::jid::node $::plugins::browser::headjid] \
           -server [::xmpp::jid::server $::plugins::browser::headjid]
    }
    $m add separator
    $m add command -label [::msgcat::mc "Browse"] \
          -command {::plugins::browser::browser_action browse \
                        $::plugins::browser::headwindow \
                        $::plugins::browser::headnode}
    $m add command -label [::msgcat::mc "Sort items by name"] \
          -command {::plugins::browser::browser_action sort \
                        $::plugins::browser::headwindow \
                        $::browser::headnode}
    $m add command -label [::msgcat::mc "Sort items by JID"] \
          -command {::plugins::browser::browser_action sortjid \
                        $::plugins::browser::headwindow \
                        $::plugins::browser::headnode}

    if {[winfo exists [set m .b3popmenu]]} {
        destroy $m
    }
    menu $m -tearoff 0
    $m add command -label [::msgcat::mc "Browse"] \
          -command {::plugins::browser::browser_action browse \
                        $::plugins::browser::headwindow \
                        $::plugins::browser::headnode}
    $m add command -label [::msgcat::mc "Sort items by name"] \
          -command {::plugins::browser::browser_action sort \
                        $::plugins::browser::headwindow \
                        $::plugins::browser::headnode}
    $m add command -label [::msgcat::mc "Sort items by JID"] \
          -command {::plugins::browser::browser_action sortjid \
                        $::plugins::browser::headwindow \
                        $::plugins::browser::headnode}

    if {[winfo exists [set m .b4popmenu]]} {
        destroy $m
    }
    menu $m -tearoff 0
    $m add command -label [::msgcat::mc "Browse"] \
          -command {::plugins::browser::browser_action browse \
                        $::plugins::browser::headwindow \
                        $::plugins::browser::headnode}

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

    # Register disco#info and disco#items in browser only.
    register_ns_handler http://jabber.org/protocol/disco#info \
            disco::browser::open_win \
            -desc [list * [::msgcat::mc "Discover service"]]
    register_ns_handler http://jabber.org/protocol/disco#items \
            disco::browser::open_win \
            -desc [list * [::msgcat::mc "Discover service"]]

    if {![catch {set m [.mainframe getmenu services]}] && $m != "" && \
            ![catch {set idx [$m index [::msgcat::mc "Service\
                                                      Discovery"]]}] && \
            $idx != "none"} {
        $m insert $idx command -label [::msgcat::mc "Jabber Browser"] \
                               -command [list [namespace current]::open]
    }
}

proc browser::unload {} {
    variable brwid
    variable browser
    variable headwindow
    variable headnode
    variable headjid

    if {![catch {set m [.mainframe getmenu services]}] && $m != "" && \
            ![catch {set idx [$m index [::msgcat::mc "Jabber Browser"]]}] && \
            $idx != "none"} {
        $m delete $idx
    }

    foreach bw [winfo children .] {
        if {[info exists browser(xlib,$bw)]} {
            destroy_win $bw
        }
    }

    if {[winfo exists [set m .b2popmenu]]} {
        destroy $m
    }
    if {[winfo exists [set m .b3popmenu]]} {
        destroy $m
    }
    if {[winfo exists [set m .b4popmenu]]} {
        destroy $m
    }

    hook::remove finload_hook [namespace current]::setup_menu

    catch {unset brwid}
    catch {unset browser}
    catch {unset headwindow}
    catch {unset headnode}
    catch {unset headjid}
}

proc browser::open {{xlib ""}} {
    variable brwid
    variable browser
    variable browse_list
    variable brwserver$brwid

    if {[llength [connections]] == 0} return

    if {$xlib == ""} {
        set xlib [lindex [connections] 0]
    }

    set brwserver$brwid [connection_server $xlib]

    set bw .brw$brwid
    set browser(xlib,$bw) $xlib

    add_win $bw -title [::msgcat::mc "Jabber Browser"] \
        -tabtitle [::msgcat::mc "Browser"] \
        -raisecmd [list focus $bw.tree] \
        -class JDisco \
        -raise 1

    set config(nscolor) [option get $bw featurecolor JDisco]

    bind $bw <Destroy> [list [namespace current]::destroy_state $bw $brwid]

    Frame $bw.navigate
    Button $bw.navigate.back -text <- -width 3 \
        -command [list [namespace current]::history_move $bw 1]
    Button $bw.navigate.forward -text -> -width 3 \
        -command [list [namespace current]::history_move $bw -1]
    Label $bw.navigate.lab -text [::msgcat::mc "JID:"]
    set c [Combobox $bw.navigate.entry \
                -textvariable [namespace current]::brwserver$brwid \
                -command [list [namespace current]::go $bw] \
                -values $browse_list]
    if {[winfo exists $c.e]} {
        #HACK: For BWidget combobox
        set c $c.e
    }
    DropSite::register $c -droptypes {JID {}} \
             -dropcmd [list [namespace current]::entrydropcmd $bw]
    Button $bw.navigate.browse -text [::msgcat::mc "Browse"] \
        -command [list [namespace current]::go $bw]

    #bind $bw.navigate.entry <Return> [list [namespace current]::go $bw]

    pack $bw.navigate.back $bw.navigate.forward $bw.navigate.lab -side left
    pack $bw.navigate.browse -side right
    pack $bw.navigate.entry -side left -expand yes -fill x
    pack $bw.navigate -fill x

    set sw [ScrolledWindow $bw.sw]

    set tw [MyTree $bw.tree]
    $sw setwidget $tw
    if {[winfo exists $tw.c]} {
        DragSite::register $tw.c \
                -draginitcmd [list [namespace current]::draginitcmd $bw]
    } else {
        DragSite::register $tw \
                -draginitcmd [list [namespace current]::draginitcmd $bw]
    }

    $tw tag configure ns -foreground $config(nscolor)

    pack $sw -side top -expand yes -fill both
    set browser(tree,$bw) $tw

    $tw tag bind Text <Double-ButtonPress-1> \
                 [list [namespace current]::activate_node [double% $bw] \
                                                          [double% $tw]]
    # Override the default action which toggles the non-leaf nodes
    bind $tw <Double-ButtonPress-1> break
    $tw tag bind Text <<ContextMenu>> \
                 [list [namespace current]::textpopup [double% $bw] %x %y]
    balloon::setup $tw -command [list [namespace current]::textballoon $bw]

    if {[winfo exists $tw.c]} {
        # HACK
        bind $tw.c <Return> \
             [list [namespace current]::activate_node [double% $bw] \
                                                      [double% $tw]]
    } else {
        $tw tag bind Text <Return> \
             [list [namespace current]::activate_node [double% $bw] \
                                                      [double% $tw]]
        # Override the default action which toggles the non-leaf nodes
        bind $tw <Return> break
    }

    set browser(ypos,$bw) 1
    set browser(width,$bw) 0
    set browser(hist,$bw) {}
    set browser(histpos,$bw) 0

    hook::run open_browser_post_hook $bw $sw $tw

    incr brwid
    go $bw
}

proc browser::enter {bw} {
    variable browser

    set jid [$bw.navigate.entry get]

    ::xmpp::sendIQ $browser(xlib,$bw) get \
        -query [::xmpp::xml::create query \
                    -xmlns jabber:iq:browse] \
        -to $jid -command [list [namespace current]::recv $bw $jid]
}

proc browser::go {bw} {
    variable browser
    variable browse_list

    if {[winfo exists $bw]} {
        set jid [$bw.navigate.entry get]

        history_add $bw $jid

        set browse_list [update_combo_list $browse_list $jid 20]
        $bw.navigate.entry configure -values $browse_list

        ::xmpp::sendIQ $browser(xlib,$bw) get \
            -query [::xmpp::xml::create query \
                        -xmlns jabber:iq:browse] \
            -to $jid -command [list [namespace current]::recv $bw $jid]
    }
}

proc browser::recv {bw jid status xml} {
    variable browser

    debugmsg browser "$status $xml"

    if {[winfo exists $bw]} {
        if {![string equal $status ok]} {
            add_item_line $bw 0 $jid {} {} {} {} $jid

            set tw $browser(tree,$bw)
            $tw delete [$tw children [jid_to_tag $jid]]
            set tnode [jid_to_tag "error $jid"]
            set data [list error $jid]
            set parent_tag [jid_to_tag $jid]
            set desc [::msgcat::mc "Browse error: %s" [error_to_string $xml]]
            set icon ""

            add_line $tw $parent_tag $tnode $icon $desc $data -tags {Text}
            set browser(nchildren,$bw,$jid) 1
        } else {
            process $bw $jid $xml 0
        }
    }
}

proc browser::process {bw from item level} {
    variable browser

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

    switch -- $tag {
        ns {
            debugmsg browser "$level; ns $cdata"
            if {![string equal $cdata ""]} {
                return [add_ns_line $bw $from $level $cdata]
            }
            return ""
        }
        query -
        item {
            set category [::xmpp::xml::getAttr $attrs category]
        }
        default {
            set category $tag
        }
    }

    set jid  [::xmpp::xml::getAttr $attrs jid]

    if {$jid eq ""} {
        set jid $from
    }

    set type [::xmpp::xml::getAttr $attrs type]
    set name [::xmpp::xml::getAttr $attrs name]
    set version [::xmpp::xml::getAttr $attrs version]

    debugmsg browser "$level; $jid; $category; $type; $name; $version"
    add_item_line $bw $level $jid $category $type $name $version $from

    set tw $browser(tree,$bw)
    set children {}
    set nchildren 0

    foreach subel $subels {
        lappend children [process $bw $jid $subel [expr {$level+1}]]
        incr nchildren
    }

    set browser(nchildren,$bw,$jid) $nchildren
    set node [jid_to_tag $jid]
    if {![info exists browser(sort,$bw,$node)]} {
        set browser(sort,$bw,$node) sort
    }
    set curchildren [$tw children $node]

    if {$level == 0} {
        foreach c $curchildren {
            if {[lsearch -exact $children $c] < 0} {
                $tw delete [list $c]
            }
        }
        browser_action $browser(sort,$bw,$node) $bw $node
        update idletasks
    }
    debugmsg browser [list $children $curchildren]

    return $node
}

proc browser::item_icon {category type} {
    switch -- $category {
        service -
        gateway -
        application {
            if {[lsearch -exact [image names] browser/$type] >= 0} {
                return browser/$type
            } else {
                return ""
            }
        }
        default {
            if {[lsearch -exact [image names] browser/$category] >= 0} {
                return browser/$category
            } else {
                return ""
            }
        }
    }
}

proc browser::add_line {tw parent node icon desc data args} {
    if {[$tw exists $node]} {
        if {[$tw parent $node] != $parent && [$tw exists $parent] && \
                $parent != $node} {
            if {[catch {$tw move $node $parent end}]} {
                debugmsg browser "MOVE FAILED: $parent $node"
            } else {
                debugmsg browser "MOVE: $parent $node"
            }
        }
        if {[$tw item $node -values] != $data} {
            debugmsg browser RECONF
            $tw item $node -text $desc -image $icon -values $data
        }
    } elseif {[$tw exists $parent]} {
        $tw insert $parent end -id $node -text $desc -open 1 -image $icon \
                  -values $data {*}$args
    } else {
        $tw insert {} end -id $node -text $desc -open 1 -image $icon \
                  -values $data {*}$args
    }

}

proc browser::add_item_line {bw level jid category type name version parent} {
    variable browser

    set icon [item_icon $category $type]
    set tw $browser(tree,$bw)
    set desc [item_desc $jid $name]
    set data [list jid $jid $category $type $name $version]
    set parent_tag [jid_to_tag $parent]
    set node [jid_to_tag $jid]

    add_line $tw $parent_tag $node $icon $desc $data -tags {Text}
}

proc browser::item_text {jid name} {
    if {$name ne ""} {
        return $name
    } else {
        return $jid
    }
}

proc browser::item_desc {jid name} {
    if {$name ne ""} {
        return "$name ($jid)"
    } else {
        return $jid
    }
}

proc browser::item_balloon_text {bw jid category type name version} {
    variable browser

    set text "$jid: "
    set delim ""
    if {$category ne "" || $type ne ""} {
        append text "$delim$category/$type"
        set delim ", "
    }
    if {$name ne ""} {
        append text "$delim[::msgcat::mc Description:] $name"
        set delim ", "
    }
    if {$version ne ""} {
        append text "$delim[::msgcat::mc Version:] $version"
    }
    append text "\n[::msgcat::mc {Number of children:}]\
                 $browser(nchildren,$bw,$jid)"
    return $text
}

proc browser::add_ns_line {bw jid level ns} {
    variable browser

    set tw $browser(tree,$bw)

    set node ${ns}\#[jid_to_tag $jid]
    set parent_tag [jid_to_tag $jid]
    lassign [$tw item $parent_tag -values] ignore1 ignore2 category type
    set data [list ns $jid $ns $category $type]
    set desc $ns
    if {[info exists browser(ns_handler_desc,$ns)]} {
        array set tmp $browser(ns_handler_desc,$ns)
        if {[info exists tmp($category)]} {
            set desc "$tmp($category) ($ns)"
        } elseif {[info exists tmp(*)]} {
            set desc "$tmp(*) ($ns)"
        }
    } elseif {[info exists \
                    ::disco::browser::browser(feature_handler_desc,$ns)]} {
        array set tmp $::disco::browser::browser(feature_handler_desc,$ns)
        if {[info exists tmp($category)]} {
            set desc "$tmp($category) ($ns)"
        } elseif {[info exists tmp(*)]} {
            set desc "$tmp(*) ($ns)"
        }
    }
    set icon ""

    add_line $tw $parent_tag $node $icon $desc $data -tags {Text ns}

    return $node
}

proc browser::history_move {bw shift} {
    variable browser

    set newpos [expr {$browser(histpos,$bw) + $shift}]

    if {$newpos < 0} {
        return
    }

    if {$newpos >= [llength $browser(hist,$bw)]} {
        return
    }

    set newjid [lindex $browser(hist,$bw) $newpos]
    set browser(histpos,$bw) $newpos

    $bw.navigate.entry set $newjid
    enter $bw
}

proc browser::history_add {bw jid} {
    variable browser

    set browser(hist,$bw) [lreplace $browser(hist,$bw) 0 \
                               [expr {$browser(histpos,$bw) - 1}]]

    set browser(hist,$bw) [linsert $browser(hist,$bw) 0 $jid]
    set browser(histpos,$bw) 0
    debugmsg browser $browser(hist,$bw)
}

proc browser::parse_items {from item} {
    variable browser

    debugmsg browser "BR: $item"

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

    switch -- $tag {
        ns {
            return
        }
        item {
            set category [::xmpp::xml::getAttr $attrs service]
        }
        default {
            set category $tag
        }
    }

    set jid  [::xmpp::xml::getAttr $attrs jid]

    if {[string equal $jid ""]} {
        set jid $from
    }

    set type [::xmpp::xml::getAttr $attrs type]
    set name [::xmpp::xml::getAttr $attrs name]
    set version [::xmpp::xml::getAttr $attrs version]

    debugmsg browser "$jid; $category; $type; $name; $version"

    set browser(name,$jid) $name
    set browser(category,$jid) $category
    set browser(type,$jid) $type

    foreach subel $subels {
        parse_items $jid $subel
    }

}

proc browser::goto {bw jid} {
    $bw.navigate.entry set $jid
    go $bw
}

proc browser::activate_node {bw tw} {
    set node [lindex [$tw selection] 0]
    if {$node != ""} {
        textaction $bw $node
    }
}

proc browser::textaction {bw node} {
    variable browser

    set tw $browser(tree,$bw)
    set data [$tw item $node -values]
    set data2 [lassign $data type]
    switch -- $type {
        jid {
            lassign $data2 jid
            goto $bw $jid
        }
        ns {
            lassign $data2 jid ns category subtype
            debugmsg browser "$jid $ns"
            if {[info exists browser(ns_handler,$ns)]} {
                if {$browser(ns_handler_node,$ns)} {
                    {*}$browser(ns_handler,$ns) $browser(xlib,$bw) $jid "" \
                                -category $category -type $subtype
                } else {
                    {*}$browser(ns_handler,$ns) $browser(xlib,$bw) $jid \
                                -category $category -type $subtype
                }
            } elseif {[info exists \
                            ::disco::browser::browser(feature_handler,$ns)]} {
                if {$::disco::browser::browser(feature_handler_node,$ns)} {
                    {*}$::disco::browser::browser(feature_handler,$ns) \
                                $browser(xlib,$bw) $jid "" \
                                -category $category -type $subtype
                } else {
                    {*}$::disco::browser::browser(feature_handler,$ns) \
                                $browser(xlib,$bw) $jid \
                                -category $category -type $subtype
                }
            }
        }
    }
}

proc browser::textpopup {bw x y} {
    variable browser
    variable headwindow $bw
    variable headjid

    set tw $browser(tree,$bw)
    $tw selection set [list [$tw identify item $x $y]]
    set node [lindex [$tw selection] 0]
    variable headnode $node

    if {[catch {$tw item $node -values} data]} {
        return
    }
    set type [lindex $data 0]

    switch -- $type {
        jid {
            switch -- [lindex $data 2] {
                user {
                    message::subject_menu [set bm .b1popmenu] \
                            $browser(xlib,$bw) [lindex $data 1] message
                }

                conference {
                    if {[string first @ [set headjid [lindex $data 1]]] > 0} {
                        set bm .b2popmenu
                    } else {
                        set bm .b3popmenu
                    }
                }

                service -
                default {
                    set bm .b3popmenu
                }
            }
        }

        ns {
            set bm .b4popmenu
        }
    }

    tk_popup $bm [winfo pointerx .] [winfo pointery .]
}

proc browser::browser_action {action bw node} {
    variable browser

    if {[catch {[set tw $browser(tree,$bw)] item $node -values} data]} {
        return
    }
    set type [lindex $data 0]

    switch -glob -- $type/$action {
        jid/browse -
        ns/browse {
            textaction $bw $node
        }

        jid/sort {
            set browser(sort,$bw,$node) sort
            set namespaces {}
            set children {}
            foreach child [$tw children $node] {
                set data [$tw item $child -values]
                switch -- [lindex $data 0] {
                    ns {
                        lappend namespaces [list $child [lindex $data 4]]
                    }
                    default {
                        lappend children [list $child [lindex $data 4]]
                    }
                }
            }
            set neworder {}
            foreach child [concat $namespaces \
                                  [lsort -dictionary -index 1 $children]] {
                lappend neworder [lindex $child 0]
            }
            $tw children $node $neworder

            foreach child [$tw children $node] {
                browser_action $action $bw $child
            }
        }

        jid/sortjid {
            set browser(sort,$bw,$node) sortjid
            set namespaces {}
            set children {}
            foreach child [$tw children $node] {
                set data [$tw item $child -values]
                switch -- [lindex $data 0] {
                    ns {
                        lappend namespaces [list $child [lindex $data 1]]
                    }
                    default {
                        lappend children [list $child [lindex $data 1]]
                    }
                }
            }
            set neworder {}
            foreach child [concat $namespaces \
                                  [lsort -dictionary -index 1 $children]] {
                lappend neworder [lindex $child 0]
            }
            $tw children $node $neworder

            foreach child [$tw children $node] {
                browser_action $action $bw $child
            }
        }

        default {
        }
    }
}

proc browser::textballoon {bw args} {
    variable browser

    set tw $browser(tree,$bw)

    if {[llength $args] == 1} {
        set node [lindex $args 0]
    } else {
        set bd [ttk::style lookup Treeview -borderwidth {} 1]
        set x [expr {[winfo pointerx $tw] - [winfo rootx $tw] - $bd}]
        set y [expr {[winfo pointery $tw] - [winfo rooty $tw] - $bd}]
        set node [$tw identify item $x $y]
        if {$node eq ""} {
            return [list $bw:$node ""]
        }
    }

    set data [lassign [$tw item $node -values] \
                      type jid category subtype name version]
    if {$type == "jid"} {
        return [list $bw:$node \
                     [item_balloon_text \
                          $bw $jid $category $subtype $name $version]]
    } else {
        return [list $bw:$node ""]
    }
}

proc browser::draginitcmd {bw t x y top} {
    if {[winfo exists [winfo parent $tw].c]} {
        # HACK for BWidget Tree
        set tw [winfo parent $tw]
    }

    set node [lindex [$tw identify item [expr {$x-[winfo rootx $tw]}] \
                                        [expr {$y-[winfo rooty $tw]}]] 0]
    set xlib browser(xlib,$bw)
    set data [$t item $node -values]
    set data2 [linsert [lassign $data type] 0 $xlib]

    if {$type == "jid"} {
        if {[set img [$t item $node -image]] != ""} {
            pack [Label $top.l -image $img -padx 0 -pady 0]
        }

        return [list JID {copy} $data2]
    } else {
        return {}
    }
}

proc browser::entrydropcmd {bw target source x y op type data} {
    set jid [lindex $data 1]
    after idle [list [namespace current]::goto $bw $jid]
}

proc browser::register_ns_handler {ns handler args} {
    variable browser

    set node 0
    set desc ""

    foreach {attr val} $args {
        switch -- $attr {
            -node {set node $val}
            -desc {set desc $val}
        }
    }

    set browser(ns_handler,$ns) $handler
    set browser(ns_handler_node,$ns) $node
    if {$desc != ""} {
        set browser(ns_handler_desc,$ns) $desc
    }
}

# Destroy all (global) state assotiated with the given browser window.
# Intended to be bound to a <Destroy> event handler for browser windows.
proc browser::destroy_state {bw brwid} {
    variable browser
    variable brwserver$brwid

    array unset browser *,$bw
    array unset browser *,$bw,*

    unset brwserver$brwid
}

# Menu setup
proc browser::setup_menu {} {
    catch {
        set m [.mainframe getmenu services]

        set idx [$m index [::msgcat::mc "Service Discovery"]]

        $m insert $idx command -label [::msgcat::mc "Jabber Browser"] \
            -command [list [namespace current]::open]
    }
}

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