# $Id$
namespace eval message {
set msgid 0
}
proc message::show_dlg {from subject body thread priority x} {
variable msgid
set mw .msg$msgid
toplevel $mw
wm title $mw "Message from $from"
frame $mw.f
grid columnconfigure $mw.f 1 -weight 1
label $mw.f.lsubj -text Subject:
entry $mw.f.subj
$mw.f.subj insert 0 $subject
$mw.f.subj configure -state disabled
grid $mw.f.lsubj -row 0 -column 0 -sticky e
grid $mw.f.subj -row 0 -column 1 -sticky ew
pack $mw.f -side top -anchor w -fill x
ButtonBox $mw.buttons
$mw.buttons add -text Reply \
-command [list message::send_dlg $from $subject $thread]
$mw.buttons add -text Close -command [list destroy $mw]
pack $mw.buttons -side bottom -anchor e
ScrolledWindow $mw.sw
text $mw.body -width 50 -height 10 \
-yscrollcommand [list $mw.scroll set]
$mw.body insert 0.0 $body
$mw.body configure -state disabled
$mw.sw setwidget $mw.body
pack $mw.sw -side bottom -fill both -expand yes
foreach xe $x {
process_x $mw.f $xe
}
focus $mw.body
incr msgid
}
proc message::process_x {f x} {
jlib::wrapper:splitxml $x tag vars isempty chdata children
set xmlns [jlib::wrapper:getattr $vars xmlns]
switch -- $xmlns {
jabber:x:roster {
foreach child $children {
process_x_roster $f $child
}
}
jabber:x:oob {
foreach child $children {
process_x_oob $f $child
}
}
jabber:x:conference {
process_x_conference $f [jlib::wrapper:getattr $vars jid]
}
}
}
proc message::process_x_roster {f x} {
jlib::wrapper:splitxml $x tag vars isempty chdata children
lassign [grid size $f] row
incr row
set jid [jlib::wrapper:getattr $vars jid]
set name [jlib::wrapper:getattr $vars name]
if {$name != ""} {
set desc $name
} else {
set desc $jid
}
label $f.luser$row -text "Attached user:"
button $f.user$row -text $desc
grid $f.luser$row -row $row -column 0 -sticky e
grid $f.user$row -row $row -column 1 -sticky ew
}
proc message::process_x_oob {f x} {
jlib::wrapper:splitxml $x tag vars isempty chdata children
lassign [grid size $f] row
incr row
switch -- $tag {
url {
label $f.lurl$row -text "Attached URL:"
button $f.url$row -text $chdata
grid $f.lurl$row -row $row -column 0 -sticky e
grid $f.url$row -row $row -column 1 -sticky ew
}
desc {
label $f.ldesc$row -text "URL description:"
label $f.desc$row -text $chdata
grid $f.ldesc$row -row $row -column 0 -sticky e
grid $f.desc$row -row $row -column 1 -sticky ew
}
}
}
proc message::process_x_conference {f conf} {
lassign [grid size $f] row
incr row
label $f.lconf$row -text "Invited to:"
button $f.conf$row -text $conf -command [list join_group $conf $::gr_nick]
grid $f.lconf$row -row $row -column 0 -sticky e
grid $f.conf$row -row $row -column 1 -sticky ew
}
proc message::send_dlg {to subject thread} {
variable msgid
set sendargs ""
if {$thread != ""} {
lappend sendargs -thread $thread
}
set mw .msg$msgid
toplevel $mw
if {$to != ""} {
wm title $mw "Send message to $to"
} else {
wm title $mw "Send message"
}
#frame $mw.subj
#label $mw.subj.lab -text Subject:
#entry $mw.subj.entry
#$mw.subj.entry insert 0 $subject
#pack $mw.subj.lab $mw.subj.entry -side left
#pack $mw.subj -side top -anchor w
frame $mw.f
grid columnconfigure $mw.f 1 -weight 1
label $mw.f.lto -text To:
Entry $mw.f.to -dropenabled 1 -droptypes {JID {}} \
-dropcmd [list message::jiddropcmd]
$mw.f.to insert 0 $to
label $mw.f.lsubj -text Subject:
entry $mw.f.subj
$mw.f.subj insert 0 $subject
grid $mw.f.lto -row 0 -column 0 -sticky e
grid $mw.f.to -row 0 -column 1 -sticky ew
grid $mw.f.lsubj -row 1 -column 0 -sticky e
grid $mw.f.subj -row 1 -column 1 -sticky ew
pack $mw.f -side top -anchor w -fill x
frame $mw.buttons
button $mw.buttons.close -text Close -command [list destroy $mw]
button $mw.buttons.reply -text Send -command [list message::send $mw]
pack $mw.buttons.close $mw.buttons.reply -side right
pack $mw.buttons -side bottom -anchor e
text $mw.body -width 50 -height 10
pack $mw.body -side bottom -fill both -expand yes
incr msgid
}
proc message::send {mw} {
jlib::send_msg [$mw.f.to get] -type normal \
-subject [$mw.f.subj get] \
-body [$mw.body get 1.0 end]
destroy $mw
}
proc message::jiddropcmd {target source pos op type data} {
set jid [lindex $data 0]
$target delete 0 end
$target insert 0 $jid
}
proc message::show_subscribe_dlg {from x args} {
variable msgid
set status ""
foreach {attr val} $args {
switch -- $attr {
-status {set status $val}
default {puts "SHOW_SUBSCRIBE_MESSAGE: unknow attr $attr $val"}
}
}
set mw .msg$msgid
toplevel $mw
wm title $mw "Subscribe request from $from"
frame $mw.subj
label $mw.subj.lab -text "Subscribe request from $from"
pack $mw.subj.lab -side left
pack $mw.subj -side top -anchor w
frame $mw.buttons
button $mw.buttons.close -text Close -command [list destroy $mw]
button $mw.buttons.subscribe -text Subscribe \
-command [join [list [list jlib::send_presence -to $from \
-type subscribed] \
[list message::send_subscribe_dlg $from] \
[list destroy $mw]] \n]
button $mw.buttons.unsubscribe -text Unsubscribe \
-command [join [list [list jlib::send_presence -to $from \
-type unsubscribed] \
[list destroy $mw]] \n]
pack $mw.buttons.close $mw.buttons.unsubscribe $mw.buttons.subscribe \
-side right
pack $mw.buttons -side bottom -anchor e
text $mw.body -width 50 -height 10
$mw.body insert 0.0 $status
$mw.body configure -state disabled
pack $mw.body -side bottom -fill both -expand yes
incr msgid
}
proc message::send_subscribe_dlg {to} {
variable msgid
set mw .msg$msgid
toplevel $mw
wm title $mw "Send subscription to $to"
frame $mw.subj
label $mw.subj.lab -text "Send subscription to "
entry $mw.subj.entry
$mw.subj.entry insert 0 $to
pack $mw.subj.lab $mw.subj.entry -side left
pack $mw.subj -side top -anchor w
frame $mw.buttons
button $mw.buttons.close -text Close -command [list destroy $mw]
button $mw.buttons.reply -text Subscribe \
-command [list message::send_subscribe $mw]
pack $mw.buttons.close $mw.buttons.reply -side right
pack $mw.buttons -side bottom -anchor e
text $mw.body -width 50 -height 10
$mw.body insert 0.0 "I would like to add you to my roster."
pack $mw.body -side bottom -fill both -expand yes
incr msgid
}
proc message::send_subscribe {mw} {
jlib::send_presence -to [$mw.subj.entry get] -type subscribe \
-status [$mw.body get 1.0 end]
jlib::send_iq set \
[jlib::wrapper:createtag query \
-vars {xmlns jabber:iq:roster} \
-subtags [list [jlib::wrapper:createtag item \
-vars [list jid \
[$mw.subj.entry get]]]]]
destroy $mw
}
# TODO: remove "puts stderr" after a little more testing...
proc show_headline {from subject body thread priority x} {
global font w
puts stderr "x=$x"
jlib::wrapper:splitxml $x tag vars isempty chdata children
puts stderr " tag=$tag vars=$vars isempty=$isempty chdata=$chdata"
if {![cequal [jlib::wrapper:getattr $vars xmlns] jabber:x:oob]} {
return
}
set desc ""
set url ""
foreach item $children {
puts stderr "item=$item"
jlib::wrapper:splitxml $item tag vars isempty chdata children
puts stderr " tag=$tag vars=$vars isempty=$isempty chdata=$chdata"
switch -- $tag {
desc - url {
set $tag $chdata
}
}
}
if {([cequal $desc ""]) || ([cequal $url ""])} {
return
}
set hw $w.headlines
set tw $hw.tree
if {![winfo exists $hw]} {
add_win $hw -title "Headlines" -tabtitle "Headlines" \
-raisecmd [list focus $hw.tree] -class JBrowser
set sw [ScrolledWindow $hw.sw]
$sw setwidget [Tree $tw -deltax 16 -deltay 18]
pack $sw -side top -expand yes -fill both
$tw bindText <Double-ButtonPress-1> [list headline_action $hw]
$tw bindText <Any-Enter> [list headline_balloon $hw enter %X %Y]
$tw bindText <Any-Motion> [list headline_balloon $hw motion %X %Y]
$tw bindText <Any-Leave> [list headline_balloon $hw leave %X %Y]
# HACK
bind $tw.c <Return> "headline_action $hw \[$tw selection get\]"
bind $tw.c <4> {
%W yview scroll -1 units
}
bind $tw.c <5> {
%W yview scroll 1 units
}
}
if {![$tw exists $from]} {
### TODO: replace br_user
$tw insert end root $from -text $from -open 1 -image br_user \
-font $font -data [list publisher] \
-fill [option get $hw fill JBrowser]
}
if {[$tw exists $from/$subject]} {
$tw delete $from/$subject
}
$tw insert end $from $from/$subject -text $subject -open 1 \
-data [list article $desc $url] \
-fill [option get $hw fill JBrowser]
}
proc headline_action {hw node} {
lassign [$hw.tree itemcget $node -data] type body url
switch -- $type {
article {
if {[clength [info commands browseurl]] == 0} {
set_status \
"Please define 'proc browseurl' in ~/.tkabber/config.tcl"
} else {
set_status [cconcat "browsing " $url]
browseurl $url
set_status ""
}
}
default {
return
}
}
}
proc headline_balloon {hw action X Y node} {
lassign [$hw.tree itemcget $node -data] type body url
switch -- $type {
article {
}
default {
return
}
}
switch -- $action {
enter {
balloon::set_text $body
}
motion {
balloon::on_mouse_move $body $X $Y
}
leave {
balloon::destroy
}
}
}