# $Id: browser.tcl 1354 2008-01-28 17:39:01Z 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]

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


proc browser::open {args} {
    variable brwid
    variable browser
    variable config
    variable browse_list
    global brwserver$brwid

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

    set brwserver$brwid [jlib::connection_server $connid]

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

    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]

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

    jlib::send_iq get \
	[jlib::wrapper:createtag query \
	     -vars {xmlns jabber:iq:browse}] \
	-to $jid -command [list [namespace current]::recv $bw $jid] \
	-connection $browser(connid,$bw)
}

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

	jlib::send_iq get \
	    [jlib::wrapper:createtag query \
		 -vars {xmlns jabber:iq:browse}] \
	    -to $jid -command [list [namespace current]::recv $bw $jid] \
	    -connection $browser(connid,$bw)
    }
}

proc browser::recv {bw jid res child} {
    variable config
    variable browser

    debugmsg browser "$res $child"

    if {[winfo exists $bw]} {
	if {![cequal $res 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 [format [::msgcat::mc "Browse error: %s"] [error_to_string $child]]
	    set icon ""

	    add_line $tw $parent_tag $tnode $icon $desc $data \
		-fill $config(fill)
	    set browser(nchilds,$bw,$jid) 1
	} else {
	    process $bw $jid $child 0
	}
    }
}

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

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

    switch -- $tag {
	ns {
	    debugmsg browser "$level; ns $chdata"
	    if {![cequal $chdata ""]} {
		return [add_ns_line $bw $from $level $chdata]
	    }
	    return ""
	}
	query -
	item {
	    set category [jlib::wrapper:getattr $vars category]
	}
	default {
	    set category $tag
	}
    }

    set jid  [jlib::wrapper:getattr $vars jid]
    
    if {[cequal $jid ""]} {
	set jid $from
    }

    set type [jlib::wrapper:getattr $vars type]
    set name [jlib::wrapper:getattr $vars name]
    set version [jlib::wrapper:getattr $vars 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 childs {}
    set nchilds 0

    foreach child $children {
	lappend childs [process $bw $jid $child [expr {$level+1}]]
	incr nchilds
    }

    set browser(nchilds,$bw,$jid) $nchilds
    set node [jid_to_tag $jid]
    if {![info exists browser(sort,$bw,$node)]} {
	set browser(sort,$bw,$node) sort
    }
    set curchilds [$tw nodes $node]

    if {$level == 0} {
	foreach c $curchilds {
	    if {![lcontain $childs $c]} {
		$tw delete $c
	    }
	}
	browser_action $browser(sort,$bw,$node) $bw $node
	update idletasks
    }
    debugmsg browser [list $childs $curchilds]

    return $node
}

image create photo ""

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(nchilds,$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)"
	}
    }
    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"

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

    
    switch -- $tag {
	ns {
	    return
	}
	item {
	    set category [jlib::wrapper:getattr $vars service]
	}
	default {
	    set category $tag
	}
    }

    set jid  [jlib::wrapper:getattr $vars jid]
    
    if {[cequal $jid ""]} {
	set jid $from
    }

    set type [jlib::wrapper:getattr $vars type]
    set name [jlib::wrapper:getattr $vars name]
    set version [jlib::wrapper:getattr $vars version]

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

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

    foreach child $children {
	parse_items $jid $child
    }

}

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 $jid "" \
			-category $category -type $subtype \
			-connection $browser(connid,$bw)]
		} else {
		    eval $browser(ns_handler,$ns) [list $jid \
			-category $category -type $subtype \
			-connection $browser(connid,$bw)]
		}
	    }
	}
    }
}

if {[winfo exists [set m .b2popmenu]]} {
    destroy $m
}
menu $m -tearoff 0
$m add command -label [::msgcat::mc "Join group..."] -command {
    join_group_dialog -server [server_from_jid $::plugins::browser::headjid] \
	    -group [node_from_jid $::plugins::browser::headjid] \
	    -connection $::plugins::browser::browser(connid,$::plugins::browser::headwindow)
}
$m add command -label [::msgcat::mc "Add conference..."] -command {
    plugins::conferences::add_conference_dialog \
	-group [node_from_jid $::plugins::browser::headjid] \
	-server [server_from_jid $::plugins::browser::headjid] \
	-connection $::plugins::browser::browser(connid,$::plugins::browser::headwindow)
}
$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}

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(connid,$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 connid browser(connid,$bw)
    set data [$t itemcget $node -data]
    set data2 [linsert [lassign $data type] 0 $connid]

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

hook::add browser_register_feature_handler_hook \
	  [namespace current]::browser::register_ns_handler

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

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

# Register disco#info and disco#items in browser only.
hook::add postload_hook \
    [list [namespace current]::browser::register_ns_handler \
	  $::NS(disco_info) disco::browser::open_win \
	  -desc [list * [::msgcat::mc "Discover service"]]]
hook::add postload_hook \
    [list [namespace current]::browser::register_ns_handler \
	  $::NS(disco_items) disco::browser::open_win \
	  -desc [list * [::msgcat::mc "Discover service"]]]

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

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

