# $Id$
option add *JBrowser.cbackground White widgetDefault
option add *JBrowser.foreground Black widgetDefault
option add *JBrowser.levelindent 24 widgetDefault
option add *JBrowser.indent 3 widgetDefault
option add *JBrowser.nsindent 2 widgetDefault
option add *JBrowser.linepad 2 widgetDefault
option add *JBrowser.toppad 1 widgetDefault
option add *JBrowser.bottompad 1 widgetDefault
option add *JBrowser.icontextpad 2 widgetDefault
option add *JBrowser.fill Black widgetDefault
option add *JBrowser.activefill AliceBlue widgetDefault
option add *JBrowser.border White widgetDefault
option add *JBrowser.nscolor MidnightBlue widgetDefault
option add *JBrowser.nsactivecolor Blue widgetDefault
option add *JBrowser*Tree*background White startupFile
namespace eval browser {
set brwid 0
}
proc browser::open {} {
variable brwid
variable browser
variable config
global brwserver$brwid
global loginconf
set brwserver$brwid $loginconf(server)
set bw .brw$brwid
add_win $bw -title "Jabber Browser" -tabtitle "JBrowser" \
-raisecmd [list focus $bw.tree] -class JBrowser
#toplevel $bw -class JBrowser
#wm title $bw "Jabber Browser"
set config(background) [option get $bw cbackground JBrowser]
set config(levelindent) [option get $bw levelindent JBrowser]
set config(indent) [option get $bw indent JBrowser]
set config(nsindent) [option get $bw nsindent JBrowser]
set config(linepad) [option get $bw linepad JBrowser]
set config(toppad) [option get $bw toppad JBrowser]
set config(bottompad) [option get $bw bottompad JBrowser]
set config(icontextpad) [option get $bw icontextpad JBrowser]
set config(foreground) [option get $bw foreground JBrowser]
set config(fill) [option get $bw fill JBrowser]
set config(activefill) [option get $bw activefill JBrowser]
set config(border) [option get $bw border JBrowser]
set config(nscolor) [option get $bw nscolor JBrowser]
set config(nsactivecolor) [option get $bw nsactivecolor JBrowser]
frame $bw.navigate
button $bw.navigate.back -text <- \
-command [list browser::history_move $bw 1]
button $bw.navigate.forward -text -> \
-command [list browser::history_move $bw -1]
label $bw.navigate.lab -text JID:
Entry $bw.navigate.entry -textvariable brwserver$brwid \
-dropenabled 1 -droptypes {JID {}} \
-dropcmd [list browser::entrydropcmd $bw] \
-command [list browser::go $bw]
button $bw.navigate.browse -text Browse \
-command [list browser::go $bw]
#bind $bw.navigate.entry <Return> [list browser::go $bw]
pack $bw.navigate.back $bw.navigate.forward $bw.navigate.lab -side left
pack $bw.navigate.entry -side left -expand yes -fill x
pack $bw.navigate.browse -side left
pack $bw.navigate -fill x
set sw [ScrolledWindow $bw.sw]
set tw [Tree $bw.tree -deltax 16 -deltay 18 -dragenabled 1 \
-draginitcmd browser::draginitcmd]
$sw setwidget $tw
pack $sw -side top -expand yes -fill both
set browser(tree,$bw) $tw
$tw bindText <Double-ButtonPress-1> [list browser::textaction $bw]
$tw bindText <Any-Enter> [list browser::textballoon $bw enter %X %Y]
$tw bindText <Any-Motion> [list browser::textballoon $bw motion %X %Y]
$tw bindText <Any-Leave> [list browser::textballoon $bw leave %X %Y]
# HACK
bind $tw.c <Return> "browser::textaction $bw \[$tw selection get\]"
bind $tw.c <4> {
%W yview scroll -1 units
}
bind $tw.c <5> {
%W yview scroll 1 units
}
#button $bw.close -text Close -command [list destroy $bw]
#pack $bw.close -side bottom -anchor e
set browser(ypos,$bw) 1
set browser(width,$bw) 0
set browser(hist,$bw) {}
set browser(histpos,$bw) 0
incr brwid
browser::go $bw
}
proc browser::enter {bw} {
variable browser
set jid [$bw.navigate.entry get]
jlib::send_iq get \
[jlib::wrapper:createtag item \
-vars {xmlns jabber:iq:browse}] \
-to $jid -command [list browser::recv $bw $jid]
}
proc browser::go {bw} {
variable browser
if {[winfo exists $bw]} {
set jid [$bw.navigate.entry get]
browser::history_add $bw $jid
jlib::send_iq get \
[jlib::wrapper:createtag item \
-vars {xmlns jabber:iq:browse}] \
-to $jid -command [list browser::recv $bw $jid]
}
}
proc browser::recv {bw jid res child} {
debugmsg browser "$res $child"
if {![cequal $res OK]} {
return
}
if {[winfo exists $bw]} {
browser::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 [browser::add_ns_line $bw $from $level $chdata]
}
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 "$level; $jid; $category; $type; $name; $version"
add_item_line $bw $level $jid $category $type $name $version $from
set tw $browser(tree,$bw)
set childs {}
foreach child $children {
lappend childs [browser::process $bw $jid $child [expr $level+1]]
}
set curchilds [$tw nodes [jid_to_tag $jid]]
if {$level == 0} {
foreach c $curchilds {
if {![lcontain $childs $c]} {
$tw delete $c
}
}
update idletasks
}
debugmsg browser [list $childs $curchilds]
return [jid_to_tag $jid]
}
image create photo unknown_pixmap -file [fullpath pixmaps unknown.gif]
image create photo service_jabber -file [fullpath pixmaps service-jabber.gif]
image create photo br_group -file [fullpath jajc-bitmaps group_on.gif]
image create photo br_user -file [fullpath jajc-bitmaps user.gif]
image create photo br_jud -file [fullpath jajc-bitmaps jud.gif]
image create photo ""
proc browser::item_icon {category type} {
switch -- $category {
service {
switch -- $type {
jud {return br_jud}
default {return ""}
}
}
conference {
return br_group
}
user {
return br_user
}
default {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} {
$tw move $parent $node end
debugmsg browser "MOVE: $parent $node"
}
if {[$tw itemcget $node -data] != $data} {
debugmsg browser 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 browser::add_item_line {bw level jid category type name version parent} {
variable browser
variable config
global font
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 -font $font \
-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_binding {jid category type} {
switch -- $category {
conference {
switch -- $type {
public {
if {![cequal [node_from_jid $jid] ""]} {
return [list eval join_group [list $jid] \$gr_nick]
}
}
default {return}
}
}
default {return}
}
return
}
proc browser::item_balloon_text {jid category type name version} {
set text "${jid}: $category/$type, Description: $name, Version: $version "
return $text
}
proc browser::add_ns_line {bw jid level ns} {
variable browser
variable config
global font
set tw $browser(tree,$bw)
set node ${ns}\#[jid_to_tag $jid]
set parent_tag [jid_to_tag $jid]
set data [list ns $jid $ns]
set desc $ns
set icon ""
add_line $tw $parent_tag $node $icon $desc $data -fill $config(nscolor)
return $node
}
proc browser::ns_binding {jid ns} {
debugmsg browser "$jid $ns"
switch -- $ns {
jabber:iq:conference {
global gr_nick
join_group $jid $gr_nick
}
jabber:iq:search {
search::open $jid
}
jabber:iq:register {
register::open $jid
}
}
}
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 delete 0 end
$bw.navigate.entry insert 0 $newjid
browser::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
browser::handler $from $jid
foreach child $children {
browser::parse_items $jid $child
}
}
proc browser::handler {parent jid} {
variable browser
switch -- $browser(category,$parent) {
conference {
conference::proc_browse $parent $jid
}
}
}
proc browser::goto {bw jid} {
$bw.navigate.entry delete 0 end
$bw.navigate.entry insert 0 $jid
browser::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
browser::ns_binding $jid $ns
}
}
}
proc browser::textballoon {bw action X Y node} {
variable browser
set tw $browser(tree,$bw)
set data [$tw itemcget $node -data]
set data2 [lassign $data type]
if {$type == "jid"} {
lassign $data2 jid category type name version
} else {
return
}
switch -- $action {
enter {
balloon::set_text \
[item_balloon_text $jid $category $type $name $version]
}
motion {
balloon::on_mouse_move \
[browser::item_balloon_text $jid \
$category $type $name $version] \
$X $Y
}
leave {balloon::destroy}
}
}
proc browser::draginitcmd {t node top} {
set data [$t itemcget $node -data]
set data2 [lassign $data type]
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 0]
goto $bw $jid
}