# $Id$

##############################################################################

package require xmpp::disco

option add *JDisco.fill          Black		widgetDefault
option add *JDisco.featurecolor  MidnightBlue   widgetDefault
option add *JDisco.identitycolor DarkGreen      widgetDefault
option add *JDisco.optioncolor   DarkViolet     widgetDefault

namespace eval disco {
    variable supported_nodes
    variable supported_features {}
    variable root_nodes {}
    variable additional_items
}

proc disco::new {xlib} {
    variable tokens

    if {![info exists tokens($xlib)]} {
	set tokens($xlib) \
	    [::xmpp::disco::new $xlib \
		    -infocommand [namespace code info_query_get_handler] \
		    -itemscommand [namespace code items_query_get_handler]]
    }
}

##############################################################################

proc disco::request_items {xlib jid args} {
    variable tokens

    set node ""
    set handler {}
    set cache no

    foreach {attr val} $args {
	switch -- $attr {
	    -node    {set node $val}
	    -command {set handler $val}
	    -cache   {set cache $val}
	}
    }

    ::xmpp::disco::requestItems $tokens($xlib) $jid \
	    -node $node \
	    -cache $cache \
	    -command [namespace code [list parse_items \
					   $xlib $jid $node $handler]]
}

proc disco::parse_items {xlib jid node handler status items} {
    if {![string equal $status ok]} {
	if {$handler != ""} {
	    eval $handler [list status $items]
	}
	hook::run disco_items_hook $xlib $jid $node $status $items
	return
    }

    debugmsg disco "ITEMS: [list $items]"

    if {$handler != ""} {
	eval $handler [list ok $items]
    }
    hook::run disco_items_hook $xlib $jid $node ok $items
    return
}

##############################################################################

proc disco::request_info {xlib jid args} {
    variable tokens

    set node ""
    set handler {}
    set cache no

    foreach {attr val} $args {
	switch -- $attr {
	    -node    {set node $val}
	    -command {set handler $val}
	    -cache   {set cache $val}
	}
    }

    ::xmpp::disco::requestInfo $tokens($xlib) $jid \
	    -node $node \
	    -cache $cache \
	    -command [namespace code [list parse_info \
					   $xlib $jid $node $handler]]
}

proc disco::parse_info {xlib jid node handler status info} {
    variable additional_nodes

    if {![string equal $status ok]} {
	if {$handler != ""} {
	    eval $handler [list $status $info {} {}]
	}
	hook::run disco_info_hook $xlib $jid $node $status $info {} {} {}
	return
    }

    lassign $info identities features extras
    set featured_nodes {}

    foreach feature $features {
	if {($node == "") && [info exists additional_nodes($feature)]} {
	    lappend featured_nodes \
		    [concat [list jid $jid] $additional_nodes($feature)]
	}
    }

    set featured_nodes [lsort -unique $featured_nodes]

    debugmsg disco \
	"INFO: IDENTITIES [list $identities] FEATURES [list $features]\
	 EXTRAS [list $extras] FEATURED NODES [list $featured_nodes]"

    if {$handler != ""} {
	eval $handler [list ok $identities $features $extras]
    }
    hook::run disco_info_hook $xlib $jid $node ok $identities $features \
			      $extras $featured_nodes
    return
}

###############################################################################

proc disco::register_featured_node {feature node name} {
    variable additional_nodes

    set additional_nodes($feature) [list node $node name $name]
}

###############################################################################

proc disco::info_query_get_handler {xlib from node lang} {
    variable supported_nodes
    variable node_handlers
    variable supported_features
    variable feature_handlers
    variable extra_handlers

    if {![string equal $node ""]} {
	if {![info exists supported_nodes($node)]} {
	    # Probably temporary node
	    set res {error cancel not-allowed}
	    hook::run disco_node_reply_hook \
		      res info $node $xlib $from $lang
	    return $res
	} else {
	    # Permanent node
	    return [eval $node_handlers($node) \
			 [list info $xlib $from $lang]]
	}
    } else {
	set identities [list [list category client \
				   type     pc \
				   name     Tkabber]]

	set features [lsort -unique [concat [::xmpp::iq::registered $xlib] \
					    $supported_features]]
	set extras {}

	if {[info exists extra_handlers]} {
	    foreach h $extra_handlers {
		set res [eval $h [list $xlib $from $lang]]
		if {[llength $res] > 0} {
		    lappend extras $res
		}
	    }
	}

	return [list result $identities $features $extras]
    }
}

###############################################################################

proc disco::items_query_get_handler {xlib from node lang} {
    variable supported_nodes
    variable node_handlers
    variable root_nodes

    if {![string equal $node ""]} {
	if {![info exists supported_nodes($node)]} {
	    # Probably temporary node
	    set res {error cancel not-allowed}
	    hook::run disco_node_reply_hook \
		      res items $node $xlib $from $lang
	    return $res
	} else {
	    # Permanent node
	    return [eval $node_handlers($node) \
			 [list items $xlib $from $lang]]
	}
    } else {
	set items {}

	set myjid [my_jid $xlib $from]

	foreach node $root_nodes {
	    set item [list jid $myjid]
	    if {![string equal $supported_nodes($node) ""]} {
		lappend item name [::trans::trans $lang $supported_nodes($node)]
	    }
	    if {![string equal $node ""]} {
		lappend item node $node
	    }
	    lappend items $item
	}

	return [list result $items]
    }
}

###############################################################################

proc disco::register_feature {feature {handler ""}} {
    variable supported_features
    variable feature_handlers

    if {[lsearch $supported_features $feature] < 0} {
	lappend supported_features $feature
    }
    set feature_handlers($feature) $handler
}

###############################################################################

proc disco::unregister_feature {feature} {
    variable supported_features
    variable feature_handlers

    if {[set idx [lsearch $supported_features $feature]] >= 0} {
	set supported_features [lreplace $supported_features $idx $idx]
	unset feature_handlers($feature)
    }
}

###############################################################################

proc disco::register_node {node handler {name ""}} {
    variable root_nodes

    lappend root_nodes $node
    register_subnode $node $handler $name
}

###############################################################################

proc disco::register_subnode {node handler {name ""}} {
    variable supported_nodes
    variable node_handlers

    set supported_nodes($node) $name
    set node_handlers($node) $handler
}

###############################################################################

proc disco::register_extra {handler} {
    variable extra_handlers

    lappend extra_handlers $handler
}

###############################################################################
# Disco Browser

namespace eval disco::browser {
    set winid 0

    image create photo ""

    variable options

    # Do not show items number in node title if this number
    # is not greater than 20
    # (It is questionnable whether to add this option to Customize).
    set options(upper_items_bound) 20

    custom::defvar disco_list {} [::msgcat::mc "List of discovered JIDs."] \
	    -group Hidden
    custom::defvar node_list {} [::msgcat::mc "List of discovered JID nodes."] \
	    -group Hidden
}

###############################################################################

proc disco::browser::open_win {xlib jid args} {
    variable winid
    variable config
    variable curjid
    variable disco_list
    variable node_list
    variable browser

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

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

    if {$jid == ""} {
	set curjid($winid) [connection_server $xlib]
    } else {
	set curjid($winid) $jid
    }

    set w .disco_$winid
    set wid $winid
    incr winid
    set browser(xlib,$w) $xlib

    add_win $w -title [::msgcat::mc "Service Discovery"] \
	-tabtitle [::msgcat::mc "Discovery"] \
	-raisecmd [list focus $w.tree] \
	-class JDisco \
	-raise 1

    set config(fill) 	      [option get $w fill          JDisco]
    set config(featurecolor)  [option get $w featurecolor  JDisco]
    set config(identitycolor) [option get $w identitycolor JDisco]
    set config(optioncolor)   [option get $w optioncolor   JDisco]

    bind $w <Destroy> [list [namespace current]::destroy_state %W [double% $w]]

    frame $w.navigate
    button $w.navigate.back -text <- \
	-command [list [namespace current]::history_move $w 1]
    button $w.navigate.forward -text -> \
	-command [list [namespace current]::history_move $w -1]
    label $w.navigate.lentry -text [::msgcat::mc "JID:"]
    ComboBox $w.navigate.entry -textvariable [namespace current]::curjid($wid) \
	-dropenabled 1 -droptypes {JID {}} \
	-dropcmd [list [namespace current]::entrydropcmd $w] \
	-command [list [namespace current]::go $w] \
	-values $disco_list
    label $w.navigate.lnode -text [::msgcat::mc "Node:"]
    ComboBox $w.navigate.node -textvariable [namespace current]::curnode($wid) \
	-values $node_list -width 20
    button $w.navigate.browse -text [::msgcat::mc "Browse"] \
	-command [list [namespace current]::go $w]

    bind $w.navigate.entry <Return> [list [namespace current]::go [double% $w]]
    bind $w.navigate.node <Return> [list [namespace current]::go [double% $w]]

    pack $w.navigate.back $w.navigate.forward $w.navigate.lentry -side left
    pack $w.navigate.browse -side right
    pack $w.navigate.entry -side left -expand yes -fill x
    pack $w.navigate.lnode -side left
    pack $w.navigate.node -side left -expand no -fill x
    pack $w.navigate -fill x


    set sw [ScrolledWindow $w.sw]

    set tw [Tree $w.tree -deltax 16 -deltay 18 -dragenabled 1 \
		-draginitcmd [list [namespace current]::draginitcmd $w]]
    $sw setwidget $tw

    pack $sw -side top -expand yes -fill both
    $tw bindText <Double-ButtonPress-1> \
	[list [namespace current]::textaction $w]
    $tw bindText <ButtonPress-3> \
	[list [namespace current]::textpopup $w]
    balloon::setup $tw -command [list [namespace current]::textballoon $w]
    bindscroll $tw.c

    # HACK
    bind $tw.c <Return> [list [namespace current]::activate_node [double% $w] [double% $tw]]
    bind $tw.c <Delete> [list [namespace current]::delete_node [double% $w] [double% $tw]]

    lappend browser(opened) $w
    set browser(opened) [lrmdups $browser(opened)]
    set browser(required,$w) {}
    set browser(tree,$w) $tw

    set browser(hist,$w) {}
    set browser(histpos,$w) 0

    hook::run open_disco_post_hook $w $sw $tw

    go $w
}

proc disco::browser::go {bw} {
    variable browser
    variable disco_list
    variable node_list

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

	history_add $bw [list $jid $node]

        set disco_list [update_combo_list $disco_list $jid 20]
        set node_list [update_combo_list $node_list $node 20]
	$bw.navigate.entry configure -values $disco_list
	$bw.navigate.node configure -values $node_list

	lappend browser(required,$bw) $jid
	set browser(required,$bw) [lrmdups $browser(required,$bw)]

	disco::request_info $browser(xlib,$bw) $jid -node $node
	disco::request_items $browser(xlib,$bw) $jid -node $node
    }
}

proc disco::browser::info_receive \
     {xlib jid node res identities features extras featured_nodes} {
    variable browser

    if {![info exists browser(opened)]} return

    foreach w $browser(opened) {
	if {[winfo exists $w] && [lcontain $browser(required,$w) $jid]} {
	    draw_info $w $xlib $jid $node $res $identities \
		      $features $extras $featured_nodes
	}
    }
}

hook::add disco_info_hook \
	  [namespace current]::disco::browser::info_receive

proc disco::browser::draw_info \
     {w xlib jid node res identities features extras featured_nodes} {
    variable browser
    variable config

    set tw $browser(tree,$w)

    set parent_tag [jid_to_tag [list $jid $node]]
    set tnode [jid_to_tag [list $jid $node]]
    if {[$tw exists $tnode]} {
	lassign [$tw itemcget $tnode -data] type _ _ _ name _ _ nitems
    } else {
	set type item
	set name ""
	set nitems 0
    }
    set data [list $type $xlib $jid $node $name $identities $features $nitems]
    set desc [item_desc $jid $node $name $nitems]
    set icon ""

    add_line $tw $parent_tag $tnode $icon $desc $data \
	-fill $config(fill)

    if {$res != "ok"} {
	set tnode [jid_to_tag "error info $jid $node"]
	set data [list error_info $xlib $jid]
	set desc [::msgcat::mc "Error getting info: %s" \
		      [error_to_string $identities]]
	set icon ""

	add_line $tw $parent_tag $tnode $icon $desc $data \
	    -fill $config(identitycolor)

	remove_old $tw $parent_tag identity   [list $tnode]
	remove_old $tw $parent_tag feature    [list $tnode]
	remove_old $tw $parent_tag extra      [list $tnode]
	remove_old $tw $parent_tag item2      [list $tnode]
	remove_old $tw $parent_tag error_info [list $tnode]
	reorder_node $tw $parent_tag
	return
    }

    set identitynodes {}

    set category ""
    set type ""
    foreach identity $identities {
	set tnode [jid_to_tag "identity $identity $jid $node"]
	lappend identitynodes $tnode
	set name     [::xmpp::xml::getAttr $identity name]
	set category [::xmpp::xml::getAttr $identity category]
	set type     [::xmpp::xml::getAttr $identity type]
	set data [list identity $xlib $jid $node $category $type $name]
	set desc "$name ($category/$type)"
	set icon [item_icon $category $type]

	add_line $tw $parent_tag $tnode $icon $desc $data \
		 -fill $config(identitycolor)
    }

    set extranodes {}

    foreach eform $extras {
	foreach {etag extra} $eform {
	    lassign $extra var type label values
	    if {$type == "hidden"} continue
	    set tnode [jid_to_tag "extra $var $jid $node"]
	    lappend extranodes $tnode
	    set data [list extra $var $xlib $jid $node]
	    set value [join $values ", "]
	    if {$label != ""} {
		set desc "$label ($var): $value"
	    } else {
		set desc "$var: $value"
	    }
	    set icon ""

	    add_line $tw $parent_tag $tnode $icon $desc $data \
		     -fill $config(identitycolor)
	}
    }

    set featurenodes {}

    foreach feature $features {
	set tnode [jid_to_tag "feature $feature $jid $node"]
	lappend featurenodes $tnode

	set data [list feature $xlib $jid $node $feature $category $type]
	set desc $feature
	if {[info exists browser(feature_handler_desc,$feature)]} {
	    catch { array unset tmp }
	    array set tmp $browser(feature_handler_desc,$feature)
	    if {[info exists tmp($category)]} {
		set desc "$tmp($category) ($feature)"
	    } elseif {[info exists tmp(*)]} {
		set desc "$tmp(*) ($feature)"
	    }
	}
	set icon ""

	add_line $tw $parent_tag $tnode $icon $desc $data \
		 -fill $config(featurecolor)
    }

    set item2nodes {}

    # Draw all implicit item nodes, which are not received explicitly
    # (don't overwrite node because it can have different name)
    foreach item $featured_nodes {
	set ijid [::xmpp::xml::getAttr $item jid]
	set node [::xmpp::xml::getAttr $item node]
	set name [::xmpp::xml::getAttr $item name]

	set tnode [jid_to_tag [list $ijid $node]]
	lappend item2nodes $tnode

	if {[$tw exists $tnode]} {
	    lassign [$tw itemcget $tnode -data] type _ _ _ _ identities features nitems
	} else {
	    set type item2
	    set identities {}
	    set features {}
	    set nitems 0
	}
	set data [list item2 $xlib $ijid $node $name $identities $features $nitems]
	set desc [item_desc $ijid $node $name $nitems]
	set icon ""

	if {![$tw exists $tnode] || \
		[lindex [$tw itemcget $tnode -data] 0] != "item"} {
	    add_line $tw $parent_tag $tnode $icon $desc $data \
		     -fill $config(fill)
	}
    }

    remove_old $tw $parent_tag identity $identitynodes
    remove_old $tw $parent_tag extra    $extranodes
    remove_old $tw $parent_tag feature  $featurenodes
    remove_old $tw $parent_tag item2    $item2nodes
    remove_old $tw $parent_tag error_info {}
    reorder_node $tw $parent_tag
}

proc disco::browser::items_receive {xlib jid node res items} {
    variable browser

    if {![info exists browser(opened)]} return

    foreach w $browser(opened) {
	if {[winfo exists $w] && [lcontain $browser(required,$w) $jid]} {
	    draw_items $w $xlib $jid $node $res $items
	}
    }
}

hook::add disco_items_hook \
	  [namespace current]::disco::browser::items_receive

proc disco::browser::draw_items {w xlib jid node res items} {
    variable browser
    variable config

    set tw $browser(tree,$w)

    set parent_tag [jid_to_tag [list $jid $node]]
    set tnode [jid_to_tag [list $jid $node]]

    if {[$tw exists $tnode]} {
	lassign [$tw itemcget $tnode -data] type _ _ _ name identities features
    } else {
	set type item
	set name ""
	set identities {}
	set features {}
    }
    set nitems [llength $items]
    set data [list $type $xlib $jid $node $name $identities $features $nitems]
    set desc [item_desc $jid $node $name $nitems]
    set icon ""

    add_line $tw $parent_tag $tnode $icon $desc $data \
	     -fill $config(fill)

    if {$res != "ok"} {
	set tnode [jid_to_tag "error items $jid $node"]
	set data [list error_items $xlib $jid]
	set desc [::msgcat::mc "Error getting items: %s" \
			       [error_to_string $items]]
	set icon ""

	add_line $tw $parent_tag $tnode $icon $desc $data \
		 -fill $config(fill)

	remove_old $tw $parent_tag item [list $tnode]
	remove_old $tw $parent_tag error_items [list $tnode]
	reorder_node $tw $parent_tag
	return
    }

    set itemnodes {}

    foreach item $items {
	set ijid [::xmpp::xml::getAttr $item jid]
	set node [::xmpp::xml::getAttr $item node]
	set name [::xmpp::xml::getAttr $item name]

	set tnode [jid_to_tag [list $ijid $node]]

	if {[$tw exists $tnode]} {
	    lassign [$tw itemcget $tnode -data] type _ _ _ _ identities features nitems
	} else {
	    set type item
	    set identities {}
	    set features {}
	    set nitems 0
	}
	set data [list item $xlib $ijid $node $name $identities $features $nitems]
	set desc [item_desc $ijid $node $name $nitems]
	set icon ""

	lappend itemnodes $tnode

	add_line $tw $parent_tag $tnode $icon $desc $data \
	    -fill $config(fill)
    }
    remove_old $tw $parent_tag item $itemnodes
    remove_old $tw $parent_tag error_items {}

    if {![info exists browser(sort,$w,$parent_tag)]} {
	set browser(sort,$w,$parent_tag) sort
    }
    browser_action $browser(sort,$w,$parent_tag) $w $parent_tag
}

proc disco::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 disco "MOVE FAILED: $parent $node"
	    } else {
		debugmsg disco "MOVE: $parent $node"
	    }
	}
	if {[$tw itemcget $node -data] != $data || \
		[$tw itemcget $node -text] != $desc} {
	    debugmsg disco RECONF
	    $tw itemconfigure $node -text $desc -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 disco::browser::reorder_node {tw node {order {}}} {
    set subnodes [$tw nodes $node]

    set identities {}
    set features {}
    set extras {}
    set items {}
    foreach sn $subnodes {
	lassign [$tw itemcget $sn -data] kind
	switch -- $kind {
	    error_items -
	    item        {lappend items      $sn}
	    error_info  -
	    identity    {lappend identities $sn}
	    feature     {lappend features   $sn}
	    extra       {lappend extras     $sn}
	}
    }
    if {$order == {}} {
	$tw reorder $node [concat $identities $extras $features $items]
    } else {
	$tw reorder $node [concat $identities $extras $features $order]
    }
}

proc disco::browser::remove_old {tw node kind newnodes} {
    set subnodes [$tw nodes $node]

    set items {}
    foreach sn $subnodes {
	lassign [$tw itemcget $sn -data] kind1
	if {$kind == $kind1 && ![lcontain $newnodes $sn]} {
	    $tw delete $sn
	}
    }
}

proc disco::browser::item_desc {jid node name nitems} {
    variable options

    if {$node != ""} {
	set snode " \[$node\]"
    } else {
	set snode ""
    }
    if {$nitems > $options(upper_items_bound)} {
	set sitems " - $nitems"
    } else {
	set sitems ""
    }
    if {![string equal $name ""]} {
	return "$name$snode ($jid)$sitems"
    } else {
	return "$jid$snode$sitems"
    }
}

proc disco::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 disco::browser::textaction {bw tnode} {
    variable disco
    variable browser

    set tw $browser(tree,$bw)
    set data [$tw itemcget $tnode -data]
    set data2 [lassign $data type]
    switch -- $type {
	item -
	item2 {
	    lassign $data2 xlib jid node
	    goto $bw $jid $node
	}
	feature {
	    lassign $data2 xlib jid node feature category subtype
	    debugmsg disco $jid
	    if {$feature != ""} {
		if {[info exists browser(feature_handler,$feature)]} {
		    if {$browser(feature_handler_node,$feature)} {
			eval $browser(feature_handler,$feature) [list $xlib $jid $node \
			    -category $category -type $subtype]
		    } else {
			eval $browser(feature_handler,$feature) [list $xlib $jid \
			    -category $category -type $subtype]
		    }
		}
	    }
	}
    }
}

proc disco::browser::textpopup {bw tnode} {
    variable browser

    set m .discopopupmenu
    if {[winfo exists $m]} {
	destroy $m
    }
    menu $m -tearoff 0

    set tw $browser(tree,$bw)
    set data [$tw itemcget $tnode -data]

    # Parent node category shouldn't impact node action in theory,
    # but sometimes (e.g. when joining MUC group) it's useful.
    set tparentnode [$tw parent $tnode]
    set parentdata {}
    catch {set parentdata [$tw itemcget $tparentnode -data]}

    hook::run disco_node_menu_hook $m $bw $tnode $data $parentdata

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

proc disco::browser::textpopup_menu_setup {m bw tnode data parentdata} {
    variable browser
    set tw $browser(tree,$bw)

    if {[$m index end] != "none"} {
	$m add separator
    }

    set tparentnode [$tw parent $tnode]

    set data2 [lassign $data type]
    switch -- $type {
	feature {
	    $m add command -label [::msgcat::mc "Browse"] \
		-command [list [namespace current]::browser_action browse $bw $tnode]
	    $m add separator
	}
	item -
	item2 {
	    $m add command -label [::msgcat::mc "Browse"] \
		-command [list [namespace current]::browser_action browse $bw $tnode]
	    $m add command -label [::msgcat::mc "Sort items by name"] \
		-command [list [namespace current]::browser_action sort $bw $tnode]
	    $m add command -label [::msgcat::mc "Sort items by JID/node"] \
		-command [list [namespace current]::browser_action sortjid $bw $tnode]

	    $m add separator
	    if {$tparentnode == "root"} {
		set label [::msgcat::mc "Delete current node and subnodes"]
	    } else {
		set label [::msgcat::mc "Delete subnodes"]
	    }
	    $m add command -label $label \
		-command [list [namespace current]::clear $bw $tnode]
	}
	default {
	}
    }

    $m add command -label [::msgcat::mc "Clear window"] \
	-command [list [namespace current]::clearall $bw]
}

hook::add disco_node_menu_hook \
	  [namespace current]::disco::browser::textpopup_menu_setup 100

proc disco::browser::clearall {bw} {
    variable browser
    set tw $browser(tree,$bw)

    set subnodes [$tw nodes root]
    foreach sn $subnodes {
	$tw delete $sn
    }
}

proc disco::browser::clear {bw tnode} {
    variable browser
    set tw $browser(tree,$bw)

    set tparentnode [$tw parent $tnode]

    set type [lindex [$tw itemcget $tnode -data] 0]

    if {$tparentnode != "root"} {
	if {$type != "item" && $type != "item2"} {
	    set tnode $tparentnode
	}
	foreach sn [$tw nodes $tnode] {
	    $tw delete $sn
	}
	lassign [$tw itemcget $tnode -data] type xlib jid node name
	if {$type == "item" || $type == "item2"} {
	    set desc [item_desc $jid $node $name 0]
	    $tw itemconfigure $tnode -text $desc
	}
    } else {
	$tw delete $tnode
    }
}

proc disco::browser::activate_node {bw tw} {
    set tnode [$tw selection get]
    if {$tnode != ""} {
	textaction $bw $tnode
    }
}

proc disco::browser::delete_node {bw tw} {
    set tnode [$tw selection get]
    if {$tnode != ""} {
	clear $bw $tnode
    }
}

proc disco::browser::browser_action {action bw tnode} {
    variable browser

    set tw $browser(tree,$bw)
    set data [$tw itemcget $tnode -data]
    set data2 [lassign $data type]

    switch -glob -- $type/$action {
	item/browse -
	item2/browse -
	feature/browse {
	    textaction $bw $tnode
	}

	item/sort -
	item2/sort {
	    set browser(sort,$bw,$tnode) sort
            set items {}
            foreach child [$tw nodes $tnode] {
		set data [lassign [$tw itemcget $child -data] type]
		switch -- $type {
		    item -
		    item2 {
			lassign $data xlib jid node name
			lappend items [list $child $name]
		    }
		}
            }
            set neworder {}
            foreach item [lsort -dictionary -index 1 $items] {
                lappend neworder [lindex $item 0]
            }
            reorder_node $tw $tnode $neworder

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

	item/sortjid -
	item2/sortjid {
	    set browser(sort,$bw,$tnode) sortjid
            set items {}
	    set items_with_nodes {}
            foreach child [$tw nodes $tnode] {
		set data [lassign [$tw itemcget $child -data] type]
		switch -- $type {
		    item -
		    item2 {
			lassign $data xlib jid node
			if {$node != {}} {
			    lappend items_with_nodes \
				[list $child "$jid\u0000$node"]
			} else {
			    lappend items [list $child $jid]
			}
		    }
		}
            }
            set neworder {}
            foreach item [concat [lsort -dictionary -index 1 $items] \
				 [lsort -dictionary -index 1 $items_with_nodes]] {
                lappend neworder [lindex $item 0]
            }
            reorder_node $tw $tnode $neworder

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

	default {
	}
    }
}

# TODO
proc disco::browser::textballoon {bw node} {
    variable browser

    set tw $browser(tree,$bw)

    if {[catch {set data [$tw itemcget $node -data]}]} {
	return [list $bw:$node ""]
    }

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

proc disco::browser::goto {bw jid node} {
    $bw.navigate.entry.e delete 0 end
    $bw.navigate.entry.e insert 0 $jid
    $bw.navigate.node.e delete 0 end
    $bw.navigate.node.e insert 0 $node
    go $bw
}

proc disco::browser::get_parent_identities {bw tnode} {
    variable browser

    set t $browser(tree,$bw)
    return [get_identities $bw [$t parent $tnode]]
}

proc disco::browser::get_identities {bw tnode} {
    variable browser

    set t $browser(tree,$bw)

    lassign [$t itemcget $tnode -data] type _ _ _ _ identities
    switch -- $type {
	item -
	item2 {
	    return $identities
	}
	default {
	    return {}
	}
    }
}

proc disco::browser::get_parent_features {bw tnode} {
    variable browser

    set t $browser(tree,$bw)
    return [get_features $bw [$t parent $tnode]]
}

proc disco::browser::get_features {bw tnode} {
    variable browser

    set t $browser(tree,$bw)

    lassign [$t itemcget $tnode -data] type _ _ _ _ _ features
    switch -- $type {
	item -
	item2 {
	    return $features
	}
	default {
	    return {}
	}
    }
}

proc disco::browser::draginitcmd {bw t tnode top} {
    set data [$t itemcget $tnode -data]
    set data2 [lassign $data type xlib jid node]

    if {$type == "item" || $type == "item2"} {
	if {[set img [$t itemcget $tnode -image]] != ""} {
	    pack [label $top.l -image $img -padx 0 -pady 0]
	}

	set identities [get_identities $bw $tnode]
	if {[llength $identities] > 0} {
	    lassign [lindex $identities 0] category type
	}

	if {![info exists category]} {
	    # Using parent tag to get conference category.
	    # ??? Which else category could be got from parent?
	    set identities [get_identities $bw [$t parent $tnode]]
	    if {[llength $identities] > 0} {
		lassign [lindex $identities 0] category type
	    }

	    if {![info exists category] || ($category != "conference")} {
		# For other JIDs use heuristics from roster code.
		lassign [roster::get_category_and_subtype $xlib $jid] category type
	    }
	}

	return [list JID {copy} [list $xlib $jid $category $type "" ""]]
    } else {
	return {}
    }
}

proc disco::browser::entrydropcmd {bw target source pos op type data} {
    set jid [lindex $data 1]
    goto $bw $jid ""
}

proc disco::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 newjidnode [lindex $browser(hist,$bw) $newpos]
    set browser(histpos,$bw) $newpos

    lassign $newjidnode newjid newnode
    $bw.navigate.entry.e delete 0 end
    $bw.navigate.entry.e insert 0 $newjid
    $bw.navigate.node.e delete 0 end
    $bw.navigate.node.e insert 0 $newnode

    disco::request_info $browser(xlib,$bw) $newjid -node $newnode
    disco::request_items $browser(xlib,$bw) $newjid -node $newnode
}

proc disco::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 disco $browser(hist,$bw)
}

#proc disco::browser::item_balloon_text {jid category type name version} {
#    variable disco
#    set text [::msgcat::mc "%s: %s/%s, Description: %s, Version: %s\nNumber of children: %s" \
#	    $jid $category $type $name $version $disco(nchilds,$jid)]
#    return $text
#}

proc disco::browser::register_feature_handler {feature 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(feature_handler,$feature) $handler
    set browser(feature_handler_node,$feature) $node
    if {$desc != ""} {
	set browser(feature_handler_desc,$feature) $desc
    }
}

proc disco::browser::unregister_feature_handler {feature} {
    variable browser

    catch {unset browser(feature_handler,$feature)}
    catch {unset feature_handler_node,$feature)}
    catch {unset browser(feature_handler_desc,$feature)}
}

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

    if {$bw != $bw1} return

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

    set idx [lsearch -exact $browser(opened) $bw]
    if {$idx >= 0} {
	set browser(opened) [lreplace $browser(opened) $idx $idx]
    }
}

# vim:ts=8:sw=4:sts=4:noet