# $Id: browser.tcl 1680 2009-02-23 13:52:58Z sergei $
# Jabber Browser (XEP-0011) implementation. This XEP is deprecated,
# so its code is 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 config
    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 config}
    catch {unset headwindow}
    catch {unset headnode}
    catch {unset headjid}
}

proc browser::open {{xlib ""}} {
    variable brwid
    variable browser
    variable config
    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(fill) 	[option get $bw fill         JDisco]
    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 <- \
	-command [list [namespace current]::history_move $bw 1]
    button $bw.navigate.forward -text -> \
	-command [list [namespace current]::history_move $bw -1]
    label $bw.navigate.lab -text [::msgcat::mc "JID:"]
    ComboBox $bw.navigate.entry -textvariable [namespace current]::brwserver$brwid \
	-dropenabled 1 -droptypes {JID {}} \
	-dropcmd [list [namespace current]::entrydropcmd $bw] \
	-command [list [namespace current]::go $bw] \
	-values $browse_list
    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 [Tree $bw.tree -deltax 16 -deltay 18 -dragenabled 1 \
		-draginitcmd [list [namespace current]::draginitcmd $bw]]
    $sw setwidget $tw

    pack $sw -side top -expand yes -fill both
    set browser(tree,$bw) $tw
    $tw bindText <Double-ButtonPress-1> [list [namespace current]::textaction $bw]
    $tw bindText <ButtonPress-3>        [list [namespace current]::textpopup $bw]
    balloon::setup $tw -command [list [namespace current]::textballoon $bw]

    bindscroll $tw.c

    # HACK
    bind $tw.c <Return> \
	 "[namespace current]::textaction [list $bw] \[[list $tw] selection get\]"

    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.e 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.e 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 config
    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)
	    foreach c [$tw nodes [jid_to_tag $jid]] {
		$tw delete $c
	    }
	    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 \
		-fill $config(fill)
	    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 {[cequal $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 "$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 nodes $node]

    if {$level == 0} {
	foreach c $curchildren {
	    if {[lsearch -exact $children $c] < 0} {
		$tw delete $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 $parent $node end }]} {
		debugmsg browser "MOVE FAILED: $parent $node"
	    } else {
		debugmsg browser "MOVE: $parent $node"
	    }
	}
	if {[$tw itemcget $node -data] != $data} {
	    debugmsg browser RECONF
	    $tw itemconfigure $node -text $desc -image $icon -data $data
	}
    } elseif {[$tw exists $parent]} {
	eval {$tw insert end $parent $node -text $desc -open 1 -image $icon \
		  -data $data} $args
    } else {
	eval {$tw insert end root $node -text $desc -open 1 -image $icon \
		  -data $data} $args
    }

}

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

    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 \
	-fill $config(fill)
}

proc browser::item_text {jid name} {
    if {![cequal $name ""]} {
	return $name
    } else {
	return $jid
    }
}

proc browser::item_desc {jid name} {
    if {![cequal $name ""]} {
	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 {![cequal $category {}] || ![cequal $type {}]} {
	append text "$delim$category/$type"
	set delim ", "
    }
    if {![cequal $name {}]} {
	append text "$delim[::msgcat::mc Description:] $name"
	set delim ", "
    }
    if {![cequal $version {}]} {
	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
    variable config

    set tw $browser(tree,$bw)

    set node ${ns}\#[jid_to_tag $jid]
    set parent_tag [jid_to_tag $jid]
    lassign [$tw itemcget $parent_tag -data] 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 -fill $config(nscolor)

    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.e delete 0 end
    $bw.navigate.entry.e insert 0 $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}]]

    lvarpush browser(hist,$bw) $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.e delete 0 end
    $bw.navigate.entry.e insert 0 $jid
    go $bw
}

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

    set tw $browser(tree,$bw)
    set data [$tw itemcget $node -data]
    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)} {
		    eval $browser(ns_handler,$ns) [list $browser(xlib,$bw) $jid "" \
			-category $category -type $subtype]
		} else {
		    eval $browser(ns_handler,$ns) [list $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)} {
		    eval $::disco::browser::browser(feature_handler,$ns) [list $browser(xlib,$bw) $jid "" \
			-category $category -type $subtype]
		} else {
		    eval $::disco::browser::browser(feature_handler,$ns) [list $browser(xlib,$bw) $jid \
			-category $category -type $subtype]
		}
	    }
	}
    }
}

proc browser::textpopup {bw node} {
    variable browser
    variable headwindow $bw
    variable headnode   $node
    variable headjid

    if {[catch { [set tw $browser(tree,$bw)] itemcget $node -data } 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)] itemcget $node -data } 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 nodes $node] {
		set data [$tw itemcget $child -data]
		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 reorder $node $neworder

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

	jid/sortjid {
	    set browser(sort,$bw,$node) sortjid
	    set namespaces {}
            set children {}
            foreach child [$tw nodes $node] {
		set data [$tw itemcget $child -data]
		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 reorder $node $neworder

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

	default {
	}
    }
}

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

    set tw $browser(tree,$bw)
    set data [lassign [$tw itemcget $node -data] \
		      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 node top} {
    set xlib browser(xlib,$bw)
    set data [$t itemcget $node -data]
    set data2 [linsert [lassign $data type] 0 $xlib]

    if {$type == "jid"} {
	if {[set img [$t itemcget $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 pos op type data} {
    set jid [lindex $data 1]
    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]
    }
}

