# $Id: disco.tcl 1406 2008-05-05 08:19:13Z sergei $

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

set ::NS(disco_items) "http://jabber.org/protocol/disco#items"
set ::NS(disco_info)  "http://jabber.org/protocol/disco#info"

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::request_items {jid node args} {
    variable disco

    set handler {}
    set cache no

    foreach {attr val} $args {
	switch -- $attr {
	    -handler    {set handler $val}
	    -cache      {set cache $val}
	    -connection {set connid $val}
	}
    }
    if {![info exists connid]} {
	return -code error "disco::request_items: -connection is mandatory"
    }

    switch -- $cache {
	first -
	only -
	yes {
	    if {[info exists disco(items,$connid,$jid,$node)]} {
		set items $disco(items,$connid,$jid,$node)
		if {$handler != ""} {
		    eval $handler [list OK $items]
		}
		if {$cache != "first"} {
		    return [list OK $items]
		}
	    } elseif {$cache == "only"} {
		return NO
	    }
	}
    }

    set vars [list xmlns $::NS(disco_items)]
    if {$node != ""} {
	lappend vars node $node
    }

    jlib::send_iq get \
	    [jlib::wrapper:createtag query \
		 -vars $vars] \
	-to $jid \
	-connection $connid \
	-command [list [namespace current]::parse_items \
		       $connid $jid $node $handler]
}

proc disco::parse_items {connid jid node handler res child} {
    variable disco

    if {![string equal $res OK]} {
	if {$handler != ""} {
	    eval $handler [list ERR $child]
	}
	hook::run disco_items_hook $connid $jid $node ERR $child
	return
    }

    set items {}

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

    foreach ch $childrens {
	jlib::wrapper:splitxml $ch tag1 vars1 isempty1 chdata1 childrens1
	switch -- $tag1 {
	    item {
		set ijid  [jlib::wrapper:getattr $vars1 jid]
		set inode  [jlib::wrapper:getattr $vars1 node]
		set name  [jlib::wrapper:getattr $vars1 name]
		lappend items [list jid $ijid node $inode name $name]
		set disco(jidname,$connid,$ijid,$inode) $name
	    }
	}
    }

    set disco(items,$connid,$jid,$node) $items

    debugmsg disco "ITEMS: [list $items]"

    if {$handler != ""} {
	eval $handler [list OK $items]
    }

    hook::run disco_items_hook $connid $jid $node OK $items
}

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

proc disco::request_info {jid node args} {
    variable disco

    set handler {}
    set cache no

    foreach {attr val} $args {
	switch -- $attr {
	    -handler    {set handler $val}
	    -cache      {set cache $val}
	    -connection {set connid $val}
	}
    }
    if {![info exists connid]} {
	return -code error "disco::request_items: -connection is mandatory"
    }

    # disco(info,featured_nodes,$connid,$jid,$node) isn't cached because it
    # isn't really reported. It's for internal use only.
    set disco(info,featured_nodes,$connid,$jid,$node) {}

    switch -- $cache {
	first -
	only -
	yes {
	    if {[info exists disco(info,identities,$connid,$jid,$node)] && \
		    [info exists disco(info,identities,$connid,$jid,$node)]} {
		set identities $disco(info,identities,$connid,$jid,$node)
		set features   $disco(info,features,$connid,$jid,$node)
		set extras     $disco(info,extras,$connid,$jid,$node)
		if {$handler != ""} {
		    eval $handler [list OK $identities $features $extras]
		}
		if {$cache != "first"} {
		    return [list OK $identities $features $extras]
		}
	    } elseif {$cache == "only"} {
		return NO
	    }
	}
    }

    set vars [list xmlns $::NS(disco_info)]
    if {$node != ""} {
	lappend vars node $node
    }

    jlib::send_iq get \
	[jlib::wrapper:createtag query \
	     -vars $vars] \
	-to $jid \
	-connection $connid \
	-command [list [namespace current]::parse_info \
		       $connid $jid $node $handler]
}

proc disco::parse_info {connid jid node handler res child} {
    variable disco
    variable additional_nodes

    if {![string equal $res OK]} {
	if {$handler != ""} {
	    eval $handler [list ERR $child {} {}]
	}
	hook::run disco_info_hook $connid $jid $node ERR $child {} {} {}
	return
    }

    set identities {}
    set features {}
    set extras {}
    set featured_nodes {}

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

    foreach ch $children {
	jlib::wrapper:splitxml $ch tag1 vars1 isempty1 chdata1 children1
	switch -- $tag1 {
	    identity {
		lappend identities \
		    [list \
			 category [jlib::wrapper:getattr $vars1 category] \
			 name [jlib::wrapper:getattr $vars1 name] \
			 type [jlib::wrapper:getattr $vars1 type]]
	    }
	    feature {
		set var [jlib::wrapper:getattr $vars1 var]
		if {$var == ""} {
		    set var [jlib::wrapper:getattr $vars1 type]
		}
		lappend features [list var $var]
		if {($node == "") && [info exists additional_nodes($var)]} {
		    lappend featured_nodes \
			    [concat [list jid $jid] $additional_nodes($var)]
		    set inode [jlib::wrapper:getattr $additional_nodes($var) node]
		    set iname [jlib::wrapper:getattr $additional_nodes($var) name]
		    if {![info exists disco(jidname,$connid,$jid,$inode)]} {
			set disco(jidname,$connid,$jid,$inode) $iname
		    }
		}
	    }
	    default {
		if {[jlib::wrapper:getattr $vars1 xmlns] == $::NS(data) && \
			[jlib::wrapper:getattr $vars1 type] == "result"} {
		    lappend extras [data::parse_xdata_results $children1 -hidden 1]
		}
	    }
	}
    }

    set disco(info,identities,$connid,$jid,$node) $identities
    set disco(info,features,$connid,$jid,$node) $features
    set disco(info,extras,$connid,$jid,$node) $extras
    set disco(info,featured_nodes,$connid,$jid,$node) [lrmdups $featured_nodes]

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

    if {$handler != ""} {
	eval $handler [list OK $identities $features $extras]
    }
    hook::run disco_info_hook $connid $jid $node OK $identities $features \
			      $extras [lrmdups $featured_nodes]
}

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

proc disco::get_jid_name {connid jid node} {
    variable disco
    if {[info exists disco(jidname,$connid,$jid,$node)]} {
	return $disco(jidname,$connid,$jid,$node)
    } else {
	return ""
    }
}

proc disco::get_jid_identities {connid jid node} {
    variable disco
    if {[info exists disco(info,identities,$connid,$jid,$node)]} {
	return $disco(info,identities,$connid,$jid,$node)
    } else {
	return {}
    }
}

proc disco::get_jid_items {connid jid node} {
    variable disco
    if {[info exists disco(items,$connid,$jid,$node)]} {
	return $disco(items,$connid,$jid,$node)
    } else {
	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 {connid from lang child} {
    variable supported_nodes
    variable node_handlers
    variable supported_features
    variable feature_handlers
    variable extra_handlers

    jlib::wrapper:splitxml $child tag vars isempty chdata children
    set node [jlib::wrapper:getattr $vars node]

    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 $connid $from $lang $child
	    return $res
	} else {
	    # Permanent node
	    set restags [eval $node_handlers($node) \
			      [list info $connid $from $lang $child]]
	    if {[string equal [lindex $restags 0] error]} {
		return $restags
	    } else {
		set res [jlib::wrapper:createtag query \
			     -vars [list xmlns $::NS(disco_info) node $node] \
			     -subtags $restags]
	    }
	}
    } else {
	set restags {}

	lappend restags [jlib::wrapper:createtag identity \
			     -vars [list category client \
					 type     pc \
					 name     Tkabber]]

	foreach h $extra_handlers {
	    lappend restags [eval $h [list $connid $from $lang]]
	}

	foreach ns [lsort [concat $::iq::supported_ns $supported_features]] {
	    lappend restags [jlib::wrapper:createtag feature \
				 -vars [list var $ns]]
	}
    
	set res [jlib::wrapper:createtag query \
		     -vars [list xmlns $::NS(disco_info)] \
		     -subtags $restags]
    }
    return [list result $res]
}

iq::register_handler get query $::NS(disco_info) \
    [namespace current]::disco::info_query_get_handler

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

proc disco::items_query_get_handler {connid from lang child} {
    variable supported_nodes
    variable node_handlers
    variable root_nodes

    jlib::wrapper:splitxml $child tag vars isempty chdata children
    set node [jlib::wrapper:getattr $vars node]

    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 $connid $from $lang $child
	    return $res
	} else {
	    # Permanent node
	    set restags [eval $node_handlers($node) \
			      [list items $connid $from $lang $child]]
	    if {[string equal [lindex $restags 0] error]} {
		return $restags
	    } else {
		set res [jlib::wrapper:createtag query \
			     -vars [list xmlns $::NS(disco_items) node $node] \
			     -subtags $restags]
	    }
	}
    } else {
	set restags {}

	set myjid [my_jid $connid $from]

	foreach node $root_nodes {
	    set vars [list jid $myjid]
	    if {![string equal $supported_nodes($node) ""]} {
		lappend vars name [::trans::trans $lang $supported_nodes($node)]
	    }
	    if {![string equal $node ""]} {
		lappend vars node $node
	    }
	    lappend restags [jlib::wrapper:createtag item \
				 -vars $vars]
	}

	set res [jlib::wrapper:createtag query \
		     -vars [list xmlns $::NS(disco_items)] \
		     -subtags $restags]
    }
    return [list result $res]
}

iq::register_handler get query $::NS(disco_items) \
    [namespace current]::disco::items_query_get_handler

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

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
}

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

proc disco::publish_items {jid node action items args} {

    set command ""
    foreach {key val} $args {
	switch -- {
	    -connection { set connid $val }
	    -command { set command $val }
	}
    }
    if {![info exists connid]} {
	return "disco::publish_items: option -connection required"
    }

    jlib::send_iq set \
	[jlib::wrapper:createtag query \
	     -vars [list xmlns $::NS(disco#publish) node $node] \
	     -subtags $items] \
	-to $jid \
	-connection $connid \
	-command [list [namespace current]::publish_items_result $command]

}

proc disco::publish_items_result {command res child} {
    if {$command != ""} {
	eval $command [list $res $child]
    }
}

###############################################################################
# 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 {jid args} {
    variable winid
    variable disco
    variable config
    variable curjid
    variable disco_list
    variable node_list
    variable browser

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

    foreach {opt val} $args {
	switch -- $opt {
	    -connection { set connid $val }
	}
    }
    if {![info exists connid]} {
	set connid [lindex [jlib::connections] 0]
    }

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

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

    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]

    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 disco::go $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
    set disco(tree,$w) $tw
    $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> \
	"[namespace current]::textaction $w \[$tw selection get\]"

    bind $tw.c <Delete> \
	"[namespace current]::clear $w \[$tw selection get\]"

    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 $jid $node -connection $browser(connid,$bw)
	disco::request_items $jid $node -connection $browser(connid,$bw)
    }
}

proc disco::browser::info_receive \
     {connid 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 $connid $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 connid jid node res identities features extras featured_nodes} {
    variable browser
    variable config

    set tw $browser(tree,$w)

    set name [disco::get_jid_name $connid $jid $node]
    set tnode [jid_to_tag [list $jid $node]]
    set parent_tag [jid_to_tag [list $jid $node]]
    set data [list item $connid $jid $node]
    if {![$tw exists $tnode] || [llength [$tw nodes $tnode]] == 0} {
	set nitems 0
    } else {
	set nitems [llength [disco::get_jid_items $connid $jid $node]]
    }
    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 $connid $jid]
	#set name     [jlib::wrapper:getattr $identity name]
	set desc [format [::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]
	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     [jlib::wrapper:getattr $identity name]
	set category [jlib::wrapper:getattr $identity category]
	set type     [jlib::wrapper:getattr $identity type]
	set data [list identity $connid $jid $node $category $type]
	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 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 $connid $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 var [jlib::wrapper:getattr $feature var]
	set tnode [jid_to_tag "feature $feature $jid $node"]
	lappend featurenodes $tnode
	set data [list feature $connid $jid $node $feature $category $type]
	set desc $var
	if {[info exists browser(feature_handler_desc,$var)]} {
	    catch { array unset tmp }
	    array set tmp $browser(feature_handler_desc,$var)
	    if {[info exists tmp($category)]} {
		set desc "$tmp($category) ($var)"
	    } elseif {[info exists tmp(*)]} {
		set desc "$tmp(*) ($var)"
	    }
	}
	set icon ""

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

    # 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 [jlib::wrapper:getattr $item jid]
	set node [jlib::wrapper:getattr $item node]

	set name [jlib::wrapper:getattr $item name]
	set tnode [jid_to_tag [list $ijid $node]]
	set data [list item $connid $ijid $node]
	if {![$tw exists $tnode] || [llength [$tw nodes $tnode]] == 0} {
	    set nitems 0
	} else {
	    set nitems [llength [disco::get_jid_items $connid $ijid $node]]
	}
	set desc [item_desc $ijid $node $name $nitems]
	set icon ""

	if {![$tw exists $tnode]} {
	    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 error_info {}
    reorder_node $tw $parent_tag
}

proc disco::browser::items_receive {connid 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 $connid $jid $node $res $items
	}
    }
}

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

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

    set tw $browser(tree,$w)

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

    set name [disco::get_jid_name $connid $jid $node]
    set tnode [jid_to_tag [list $jid $node]]
    set data [list item $connid $jid $node]
    if {![$tw exists $tnode] || [llength [$tw nodes $tnode]] == 0} {
	set nitems 0
    } else {
	set nitems [llength [disco::get_jid_items $connid $jid $node]]
    }
    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"} {
	# HACK
	if {[info exists ::disco::disco(info,featured_nodes,$connid,$jid,$node)] && \
	    ![lempty $::disco::disco(info,featured_nodes,$connid,$jid,$node)]} {
	    set items {}
	} else {
	    set tnode [jid_to_tag "error items $jid $node"]
	    set data [list error_items $connid $jid]
	    #set name     [jlib::wrapper:getattr $identity name]
	    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]
	    reorder_node $tw $parent_tag
	    return
	}
    }

    # HACK
    # Don't remove nodes, which are drawn after disco#info query
    # (if the service's features change then this node list may be
    # incorrect)
    set itemnodes {}
    if {[info exists ::disco::disco(info,featured_nodes,$connid,$jid,$node)]} {
	foreach item $::disco::disco(info,featured_nodes,$connid,$jid,$node) {
	    set ijid [jlib::wrapper:getattr $item jid]
	    set inode [jlib::wrapper:getattr $item node]
	    lappend itemnodes [jid_to_tag [list $ijid $inode]]
	}
    }

    foreach item $items {
	set ijid [jlib::wrapper:getattr $item jid]
	set node [jlib::wrapper:getattr $item node]

	set name [jlib::wrapper:getattr $item name]
	set tnode [jid_to_tag [list $ijid $node]]
	set data [list item $connid $ijid $node]
	if {![$tw exists $tnode] || [llength [$tw nodes $tnode]] == 0} {
	    set nitems 0
	} else {
	    set nitems [llength [disco::get_jid_items $connid $ijid $node]]
	}
	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::negotiate_feature {tw connid jid parent type} {
    variable config

    lassign [negotiate::send_request $connid $jid $type] res opts

    if {![winfo exists $tw]} return

    if {$res != "OK"} {
	set node [jid_to_tag "error negotiate $parent"]
	set data [list error_negotiate $parent $connid $jid]
	#set name     [jlib::wrapper:getattr $identity name]
	set desc [format [::msgcat::mc "Error negotiate: %s"] \
		      [error_to_string $opts]]
	set icon ""
	
	add_line $tw $parent $node $icon $desc $data \
	    -fill $config(optioncolor)

	remove_old $tw $parent option [list $node]
	return
    }

    set optnodes {}

    foreach opt $opts {
	set node [jid_to_tag "option $opt $parent"]
	lappend optnodes $node
	set data [list option $opt $node]
	set desc $opt
	set icon ""
	
	add_line $tw $parent $node $icon $desc $data \
	    -fill $config(optioncolor)
    }
    remove_old $tw $parent option $optnodes
    remove_old $tw $parent error_negotiate {}
}


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 {
	    lassign $data2 connid jid node
	    goto $bw $jid $node
	}
	feature {
	    lassign $data2 connid jid node feature category subtype
	    set var [jlib::wrapper:getattr $feature var]
	    debugmsg disco $jid
	    if {$var != ""} {
		if {[info exists browser(feature_handler,$var)]} {
		    if {$browser(feature_handler_node,$var)} {
			eval $browser(feature_handler,$var) [list $jid $node \
			    -category $category -type $subtype \
			    -connection $connid]
		    } else {
			eval $browser(feature_handler,$var) [list $jid \
			    -category $category -type $subtype \
			    -connection $connid]
		    }
		} else {
		    negotiate_feature $tw $connid $jid $tnode $var
		}
	    }
	}
    }
}

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]
    set data2 [lassign $data type]

    # 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 {
	    $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"} {
	    set tnode $tparentnode
	}
	foreach sn [$tw nodes $tnode] {
	    $tw delete $sn
	}
	lassign [$tw itemcget $tnode -data] type connid jid node
	if {$type == "item"} {
	    set name [disco::get_jid_name $connid $jid $node]
	    set desc [item_desc $jid $node $name 0]
	    $tw itemconfigure $tnode -text $desc
	}
    } else {
	$tw delete $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 -
	feature/browse {
	    textaction $bw $tnode
	}

	item/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 {
			lassign $data connid jid node
			lappend items \
			    [list $child \
				  [disco::get_jid_name $connid $jid $node]]
		    }
		}
            }
            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 {
	    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 {
			lassign $data connid 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 disco
    variable browser

    set tw $browser(tree,$bw)

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

    lassign $data type connid 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_category_type {t tnode} {
    foreach child [$t nodes $tnode] {
	set data [$t itemcget $child -data]
        set data2 [lassign $data type connid jid node]
	if {$type == "identity"} {
	    return $data2
	}
    }
    return {}
}

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

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

	lassign [get_category_type $t $tnode] category type

	if {![info exists category]} {
	    # Using parent tag to get conference category.
	    # ??? Which else category could be got from parent?
	    lassign [get_category_type $t [$t parent $tnode]] category type

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

	return [list JID {copy} [list $connid $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 $newjid $newnode -connection $browser(connid,$bw)
    disco::request_items $newjid $newnode -connection $browser(connid,$bw)
}

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 [format [::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} {
    eval [list hook::run browser_register_feature_handler_hook \
	       $feature $handler] $args
}

proc disco::browser::register_feature_handler1 {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
    }
}

hook::add browser_register_feature_handler_hook \
	  disco::browser::register_feature_handler1

# 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} {
    variable browser

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