# $Id$
# Multi-User Chat support (JEP-0045)
namespace eval muc {
set winid 0
set options(gen_events) 1
}
set ::NS(muc) http://jabber.org/protocol/muc
set ::NS(gc_admin) http://jabber.org/protocol/muc#admin
set ::NS(gc_owner) http://jabber.org/protocol/muc#owner
set ::NS(gc_user) http://jabber.org/protocol/muc#user
proc muc::add_groupchat_user_menu_items {m jid} {
set mm [menu $m.muc -tearoff 0]
$mm add command -label [::msgcat::mc "Whois"] \
-command [list muc::whois $jid]
$mm add command -label [::msgcat::mc "Kick"] \
-command [list muc::change_item_param admin {role none} $jid ""]
$mm add command -label [::msgcat::mc "Ban"] \
-command [list muc::change_item_param admin {affiliation outcast} \
$jid ""]
$mm add command -label [::msgcat::mc "Grant Voice"] \
-command [list muc::change_item_param admin \
{role participant} $jid ""]
$mm add command -label [::msgcat::mc "Revoke Voice"] \
-command [list muc::change_item_param admin \
{role visitor} $jid ""]
$mm add command -label [::msgcat::mc "Grant Membership"] \
-command [list muc::change_item_param admin \
{affiliation member} $jid ""]
$mm add command -label [::msgcat::mc "Revoke Membership"] \
-command [list muc::change_item_param admin \
{affiliation none} $jid ""]
$mm add command -label [::msgcat::mc "Grant Moderator Privilege"] \
-command [list muc::change_item_param admin \
{role moderator} $jid ""]
$mm add command -label [::msgcat::mc "Revoke Moderator Privilege"] \
-command [list muc::change_item_param admin \
{role participant} $jid ""]
$mm add command -label [::msgcat::mc "Grant Administrative Privilege"] \
-command [list muc::change_item_param owner \
{affiliation admin} $jid ""]
$mm add command -label [::msgcat::mc "Revoke Administrative Privilege"] \
-command [list muc::change_item_param admin \
{affiliation member} $jid ""]
#$mm add command -label [::msgcat::mc "Grant Ownership Privilege"] \
# -command [list muc::change_item_param owner \
# {affiliation owner} $jid ""]
#$mm add command -label [::msgcat::mc "Revoke Ownership Privilege"] \
# -command [list muc::change_item_param admin \
# {affiliation admin} $jid ""]
$m add cascade -label [::msgcat::mc "MUC"] -menu $mm
}
hook::add roster_create_groupchat_user_menu_hook \
muc::add_groupchat_user_menu_items
proc muc::add_conference_menu_items {m jid} {
variable muc_compatible
if {![info exist muc_compatible($jid)] || !$muc_compatible($jid)} return
$m add command -label [::msgcat::mc "Invite users (MUC)..."] \
-command [list muc::invite_dialog $jid]
$m add command -label [::msgcat::mc "Configure"] \
-command [list muc::request_config query $jid]
$m add command -label [::msgcat::mc "Edit moderator list"] \
-command [list muc::request_list admin role moderator $jid]
$m add command -label [::msgcat::mc "Edit ban list"] \
-command [list muc::request_list admin affiliation outcast $jid]
$m add command -label [::msgcat::mc "Edit member list"] \
-command [list muc::request_list admin affiliation member $jid]
$m add command -label [::msgcat::mc "Edit voice list"] \
-command [list muc::request_list admin role participant $jid]
$m add command -label [::msgcat::mc "Edit admin list"] \
-command [list muc::request_list owner affiliation admin $jid]
$m add command -label [::msgcat::mc "Edit owner list"] \
-command [list muc::request_list owner affiliation owner $jid]
$m add command -label [::msgcat::mc "Destroy"] \
-command [list muc::request_destruction $jid "" ""]
}
hook::add chat_create_conference_menu_hook muc::add_conference_menu_items
proc muc::handle_commands {chatid user body type} {
if {$type != "groupchat"} return
if {[cequal [crange $body 0 5] "/kick "]} {
set level admin
set params {role none}
set nick_reason [string trim [crange $body 6 end]]
set we [string wordend $nick_reason 0]
set nick [string trim [crange $nick_reason 0 $we]]
set reason [string trim [crange $nick_reason $we end]]
} elseif {[cequal [crange $body 0 4] "/ban "]} {
set level admin
set params {affiliation outcast}
set nick_reason [string trim [crange $body 5 end]]
set we [string wordend $nick_reason 0]
set nick [string trim [crange $nick_reason 0 $we]]
set reason [string trim [crange $nick_reason $we end]]
} elseif {[cequal [crange $body 0 6] "/whois "]} {
set nick [string trim [crange $body 7 end]]
whois $chatid/$nick
return stop
} elseif {[cequal [crange $body 0 6] "/voice "]} {
set level admin
set params {role participant}
set nick [string trim [crange $body 7 end]]
set reason ""
} elseif {[cequal [crange $body 0 8] "/devoice "]} {
set level admin
set params {role visitor}
set nick [string trim [crange $body 9 end]]
set reason ""
} elseif {[cequal [crange $body 0 7] "/member "]} {
set level admin
set params {affiliation member}
set nick [string trim [crange $body 8 end]]
set reason ""
} elseif {[cequal [crange $body 0 9] "/demember "]} {
set level admin
set params {affiliation none}
set nick [string trim [crange $body 10 end]]
set reason ""
} elseif {[cequal [crange $body 0 10] "/moderator "]} {
set level admin
set params {role moderator}
set nick [string trim [crange $body 11 end]]
set reason ""
} elseif {[cequal [crange $body 0 12] "/demoderator "]} {
set level admin
set params {role participant}
set nick [string trim [crange $body 13 end]]
set reason ""
} elseif {[cequal [crange $body 0 6] "/admin "]} {
set level admin
set params {affiliation admin}
set nick [string trim [crange $body 7 end]]
set reason ""
} elseif {[cequal [crange $body 0 8] "/deadmin "]} {
set level admin
set params {affiliation member}
set nick [string trim [crange $body 9 end]]
set reason ""
} else {
return
}
change_item_param $level $params $chatid/$nick $reason
return stop
}
hook::add chat_send_message_hook muc::handle_commands 50
proc muc::commands_comps {chatid compsvar wordstart line} {
variable muc_compatible
if {![info exist muc_compatible($chatid)] || \
!$muc_compatible($chatid)} return
upvar 0 $compsvar comps
if {!$wordstart} {
lappend comps {/whois } {/kick } {/ban } \
{/voice } {/devoice } \
{/member } {/demember } \
{/moderator } {/demoderator } \
{/admin } {/deadmin }
}
}
hook::add generate_completions_hook muc::commands_comps
proc muc::whois {user} {
variable users
set group [node_and_server_from_jid $user]
set nick [chat::get_nick $user groupchat]
if {[info exists users(jid,$user)]} {
chat::add_message $group $group error \
"whois $nick: $users(jid,$user)" {}
} else {
chat::add_message $group $group error "whois $nick: no info" {}
}
}
proc muc::change_item_param {level params user reason} {
set group [node_and_server_from_jid $user]
set nick [chat::get_nick $user groupchat]
set itemsubtags {}
if {$reason != ""} {
lappend itemsubtags [jlib::wrapper:createtag reason \
-chdata $reason]
}
set item [jlib::wrapper:createtag item \
-vars [concat [list nick $nick] $params] \
-subtags $itemsubtags]
jlib::send_iq set \
[jlib::wrapper:createtag query \
-vars [list xmlns $::NS(gc_$level)] \
-subtags [list $item]] \
-to $group \
-command [list muc::test_error_res "$params $nick" $group]
}
proc muc::request_destruction {group alt reason} {
jlib::send_iq set \
[jlib::wrapper:createtag destroy \
-vars [list xmlns $::NS(gc_owner)] \
-subtags [list \
[jlib::wrapper:createtag destroy \
-subtags [list \
[jlib::wrapper:createtag alt \
-chdata $alt] \
[jlib::wrapper:createtag reason \
-chdata $reason]]]]] \
-to $group -command [list muc::test_error_res "Destroying" $group]
}
proc muc::request_list {level attr val group} {
jlib::send_iq get \
[jlib::wrapper:createtag query \
-vars [list xmlns $::NS(gc_$level)] \
-subtags [list [jlib::wrapper:createtag item \
-vars [list $attr $val]]]] \
-to $group -command [list muc::receive_list $level $attr $val $group]
}
proc muc::receive_list {level attr val group res child} {
if {![cequal $res OK]} {
chat::add_message $group $group error "$attr $val list: [error_to_string $child]" {}
return
}
jlib::wrapper:splitxml $child tag vars isempty chdata children
#data::draw_window $children [list muc::send_list $level $role $group]
variable winid
set w .muc_list$winid
incr winid
if {[winfo exists $w]} {
destroy $w
}
toplevel $w
wm title $w "Edit $val list"
wm withdraw $w
set sw [ScrolledWindow $w.sw]
set sf [ScrollableFrame $w.fields -constrainedwidth yes]
set f [$sf getframe]
$sw setwidget $sf
#data::fill_fields $f $items
fill_list $f $children $attr $val
list_add_item $f $attr $val
set bbox [ButtonBox $w.bbox]
pack $bbox -side bottom -anchor e
$bbox add -text [::msgcat::mc "Send"] \
-command [list [namespace current]::send_list \
$group $level $attr $val $w $f]
$bbox add -text [::msgcat::mc "Cancel"] -command [list destroy $w]
pack [Separator $w.sep] -side bottom -fill x
set hf [frame $w.hf]
pack $hf -side top
set vf [frame $w.vf]
pack $vf -side left
pack $sw -side top -expand yes -fill both
button $w.add -text [::msgcat::mc "Add"] \
-command [list [namespace current]::list_add_item $f $attr $val]
pack $w.add -side top -anchor e
update idletasks
$hf configure -width [expr {[winfo reqwidth $f] + 10}]
set h [winfo reqheight $f]
set sh [winfo screenheight $w]
if {$h > $sh*0.9} {
set h [expr round($sh*0.9)]
}
$vf configure -height $h
wm deiconify $w
bind $w <Destroy> [list [namespace current]::list_cleanup $w $f]
}
proc muc::fill_list {f items attr val} {
global font
variable listdata
variable origlistdata
grid columnconfig $f 0 -weight 10 -minsize 2c
grid columnconfig $f 1 -weight 10 -minsize 2c
grid columnconfig $f 4 -weight 10 -minsize 2c
label $f.lnick -text Nick
grid $f.lnick -row 0 -column 0 -sticky w
label $f.ljid -text JID
grid $f.ljid -row 0 -column 1 -sticky w
switch -- $attr {
role {
grid columnconfig $f 2 -weight 1 -minsize 2c
label $f.lrole -text Role
grid $f.lrole -row 0 -column 2 -sticky w
}
affiliation {
grid columnconfig $f 3 -weight 1 -minsize 2c
label $f.laffiliation -text Affiliation
grid $f.laffiliation -row 0 -column 3 -sticky w
}
}
label $f.lreason -text Reason
grid $f.lreason -row 0 -column 4 -sticky w
set row 1
foreach item $items {
jlib::wrapper:splitxml $item tag vars isempty chdata children
switch -- $tag {
item {
set nick [jlib::wrapper:getattr $vars nick]
set jid [jlib::wrapper:getattr $vars jid]
set role [jlib::wrapper:getattr $vars role]
set affiliation [jlib::wrapper:getattr $vars affiliation]
label $f.nick$row -text $nick -font $font \
-textvariable [namespace current]::listdata($f,nick,$row)
grid $f.nick$row -row $row -column 0 -sticky w
label $f.jid$row -text $jid -font $font \
-textvariable [namespace current]::listdata($f,jid,$row)
grid $f.jid$row -row $row -column 1 -sticky w
switch -- $attr {
role {
ComboBox $f.role$row -text $role \
-values {moderator participant visitor none} \
-editable no \
-textvariable \
[namespace current]::listdata($f,role,$row)
grid $f.role$row -row $row -column 2 -sticky we
}
affiliation {
ComboBox $f.affiliation$row -text $affiliation \
-values {owner admin member none} \
-editable no \
-textvariable \
[namespace current]::listdata($f,affiliation,$row)
grid $f.affiliation$row -row $row -column 3 -sticky we
}
}
entry $f.reason$row -font $font \
-textvariable [namespace current]::listdata($f,reason,$row)
grid $f.reason$row -row $row -column 4 -sticky we
incr row
}
}
}
set listdata($f,rows) [incr row -1]
array set origlistdata [array get listdata ${f}*]
}
proc muc::list_add_item {f attr val} {
global font
variable listdata
set row [incr listdata($f,rows)]
entry $f.nick$row -font $font \
-textvariable [namespace current]::listdata($f,nick,$row)
grid $f.nick$row -row $row -column 0 -sticky we
entry $f.jid$row -font $font \
-textvariable [namespace current]::listdata($f,jid,$row)
grid $f.jid$row -row $row -column 1 -sticky we
switch -- $attr {
role {
ComboBox $f.role$row -text none \
-values {moderator participant visitor none} \
-editable no \
-textvariable [namespace current]::listdata($f,role,$row)
grid $f.role$row -row $row -column 2 -sticky we
}
affiliation {
ComboBox $f.affiliation$row -text none \
-values {owner admin member none} \
-editable no \
-textvariable \
[namespace current]::listdata($f,affiliation,$row)
grid $f.affiliation$row -row $row -column 3 -sticky we
}
}
entry $f.reason$row -font $font \
-textvariable [namespace current]::listdata($f,reason,$row)
grid $f.reason$row -row $row -column 4 -sticky we
set listdata($f,$attr,$row) $val
}
proc muc::send_list {group level attr val w f} {
variable origlistdata
variable listdata
set items {}
for {set i 1} {$i <= $origlistdata($f,rows)} {incr i} {
set vars {}
if {$listdata($f,$attr,$i) != $origlistdata($f,$attr,$i)} {
lappend vars $attr $listdata($f,$attr,$i)
}
if {$vars != {}} {
if {$origlistdata($f,nick,$i) != ""} {
lappend vars nick $origlistdata($f,nick,$i)
}
if {$origlistdata($f,jid,$i) != ""} {
lappend vars jid $origlistdata($f,jid,$i)
}
set itemsubtags {}
set reason $listdata($f,reason,$i)
if {$reason != ""} {
lappend itemsubtags [jlib::wrapper:createtag reason \
-chdata $reason]
}
lappend items [jlib::wrapper:createtag item \
-vars $vars \
-subtags $itemsubtags]
}
}
for {} {$i <= $listdata($f,rows)} {incr i} {
set vars1 {}
set vars2 {}
if {$listdata($f,$attr,$i) != ""} {
lappend vars1 $attr $listdata($f,$attr,$i)
}
if {$listdata($f,nick,$i) != ""} {
lappend vars2 nick $listdata($f,nick,$i)
}
if {$listdata($f,jid,$i) != ""} {
lappend vars2 jid $listdata($f,jid,$i)
}
if {$vars1 != {} && $vars2 != {}} {
set vars [concat $vars2 $vars1]
set itemsubtags {}
set reason $listdata($f,reason,$i)
if {$reason != ""} {
lappend itemsubtags [jlib::wrapper:createtag reason \
-chdata $reason]
}
lappend items [jlib::wrapper:createtag item \
-vars $vars \
-subtags $itemsubtags]
}
}
if {$items != {}} {
jlib::send_iq set [jlib::wrapper:createtag query \
-vars [list xmlns $::NS(gc_$level)] \
-subtags $items] \
-to $group \
-command [list muc::test_error_res "Sending list" $group]
}
destroy $w
}
proc muc::list_cleanup {w f} {
variable listdata
variable origlistdata
array unset listdata ${f}*
array unset origlistdata ${f}*
}
proc muc::request_config {op group} {
jlib::send_iq get \
[jlib::wrapper:createtag $op \
-vars [list xmlns $::NS(gc_owner)]] \
-to $group -command [list muc::receive_config $op $group]
}
proc muc::receive_config {op group res child} {
if {![cequal $res OK]} {
chat::add_message $group $group error "$op list: [error_to_string $child]" {}
return
}
jlib::wrapper:splitxml $child tag vars isempty chdata children
#if {$tag != $op} {
# chat::add_message $group $group error \
# "Ban list: receiving wrong reply ('$tag' tag instead of '$op')" {}
# return
#}
data::draw_window $children [list muc::send_config $op $group]
return
}
proc muc::send_config {op group w restags} {
#set f $w.fields
#set restags [data::get_tags_x $f]
jlib::send_iq set [jlib::wrapper:createtag $op \
-vars [list xmlns $::NS(gc_owner)] \
-subtags $restags] \
-to $group \
-command [list muc::test_error_res "Sending $op list" $group]
destroy $w
}
proc muc::test_error_res {op group res child} {
if {![cequal $res OK]} {
chat::add_message $group $group error "$op: [error_to_string $child]" {}
return
}
}
proc muc::process_gc_user {user type childrens} {
variable users
variable options
foreach child $childrens {
jlib::wrapper:splitxml $child tag vars isempty chdata children
switch -- $tag {
item {
if {$type != "unavailable"} {
set users(jid,$user) [jlib::wrapper:getattr $vars jid]
set users(role,$user) [jlib::wrapper:getattr $vars role]
set users(affiliation,$user) \
[jlib::wrapper:getattr $vars affiliation]
} else {
set new_nick [jlib::wrapper:getattr $vars nick]
foreach ch $children {
jlib::wrapper:splitxml $ch tag1 vars1 isempty1 \
chdata1 children1
switch -- $tag {
reason {
set reason $chdata1
}
actor {
set actor [jlib::wrapper:getattr $vars1 jid]
}
}
}
}
}
status {
set code [jlib::wrapper:getattr $vars code]
switch -- $code {
301 -
307 {
set group [node_and_server_from_jid $user]
set nick [chat::get_nick $user groupchat]
switch -- $code {
301 {set action \
[format \
[::msgcat::mc \
"%s has been banned" \
$nick]]}
307 {set action \
[format \
[::msgcat::mc \
"%s has been kicked" \
$nick]]}
}
if {[info exists actor] && $actor != ""} {
append action \
[format [::msgcat::mc " by %s" $actor]]
}
if {[info exists reason] && $reason != ""} {
append action ": $reason"
}
if {$options(gen_events)} {
chat::add_message \
$group $group groupchat $action {}
}
}
303 {
set group [node_and_server_from_jid $user]
set nick [chat::get_nick $user groupchat]
if {[info exists new_nick] && $new_nick != "" && \
$options(gen_events)} {
variable ignore_available $new_nick
variable ignore_unavailable $nick
chat::add_message \
$group $group groupchat \
[format \
[::msgcat::mc "%s is now known as %s"] \
$nick $new_nick] {}
}
}
}
}
}
}
}
proc muc::process_available {group nick} {
variable options
variable ignore_available
if {[is_compatible $group] && $options(gen_events) && \
(![info exists ignore_available] || \
$ignore_available != $nick)} {
chat::add_message $group $group groupchat \
[format [::msgcat::mc "%s has become available"] $nick] {}
}
catch { unset ignore_available }
}
proc muc::process_unavailable {group nick} {
variable options
variable ignore_unavailable
if {[is_compatible $group] && $options(gen_events) && \
(![info exists ignore_unavailable] || \
$ignore_unavailable != $nick)} {
chat::add_message $group $group groupchat \
[format [::msgcat::mc "%s has left"] $nick] {}
}
catch { unset ignore_unavailable }
}
###############################################################################
proc muc::request_negotiation {group} {
jlib::send_iq get \
[jlib::wrapper:createtag query \
-vars {xmlns jabber:iq:browse}] \
-to [server_from_jid $group] \
-command [list muc::recv_negotiation $group]
}
proc muc::recv_negotiation {group res child} {
variable muc_compatible
if {![cequal $res OK]} {
set muc_compatible($group) 0
} else {
jlib::wrapper:splitxml $child tag vars isempty chdata children
foreach item $children {
jlib::wrapper:splitxml $item tag1 vars1 isempty1 chdata1 children1
if {$tag1 == "ns" && \
$chdata1 == "http://jabber.org/protocol/muc"} {
set muc_compatible($group) 1
return
}
}
set muc_compatible($group) 0
}
}
proc muc::wait_for_negotiation {group} {
vwait [namespace current]::muc_compatible($group)
}
proc muc::is_compatible {group} {
variable muc_compatible
if {[info exists muc_compatible($group)]} {
return $muc_compatible($group)
} else {
return 0
}
}
###############################################################################
proc muc::add_user_popup_info {infovar user} {
variable users
upvar 0 $infovar info
if {[info exists users(jid,$user)] && \
$users(jid,$user) != ""} {
append info "\n\tReal JID: $users(jid,$user)"
}
if {[info exists users(affiliation,$user)]} {
append info "\n\tAffiliation: $users(affiliation,$user)"
}
}
hook::add roster_user_popup_info_hook muc::add_user_popup_info
###############################################################################
proc muc::join_group {group nick {password ""}} {
set x_subtags {}
if {$password != ""} {
lappend x_subtags [jlib::wrapper:createtag password -chdata $password]
}
jlib::send_presence -to ${group}/${nick} \
-xlist [list [jlib::wrapper:createtag x \
-vars [list xmlns $::NS(muc)] \
-subtags $x_subtags]]
set_our_groupchat_nick $group $nick
chat::open_window $group groupchat
}
###############################################################################
proc muc::invite_dialog {chatid} {
variable opened
global invite_muc
set gw .invite
catch { destroy $gw }
if {[lsearch -exact $chat::chats(groupchats) $chatid] >= 0} {
set title [node_from_jid $chatid]
} else {
set title [get_nick $chatid chat]
}
Dialog $gw -title [format [::msgcat::mc "Invite users to %s"] $title] \
-separator 1 -anchor e -default 0 -cancel 1
set gf [$gw getframe]
set sw [ScrolledWindow $gf.sw]
set sf [ScrollableFrame $sw.sf]
pack $sw -expand yes -fill both
$sw setwidget $sf
set sff [$sf getframe]
$gw add -text [::msgcat::mc "Invite"] \
-command [list muc::invitation $gw $chatid]
$gw add -text [::msgcat::mc "Cancel"] -command "destroy $gw"
catch { unset invite_muc }
set choices {}
foreach choice $roster::roster(jids) {
if {![cequal $roster::roster(category,$choice) conference]} {
lappend choices [list $choice [roster::get_label $choice]]
}
}
set i 0
foreach choice [lsort -index 1 $choices] {
set gc [lindex $choice 0]
set cb [checkbutton $sff.$i -variable invite_muc($gc) \
-text [lindex $choice 1]]
bind $cb <Any-Enter> [list balloon::default_balloon $cb enter %X %Y \
$gc]
bind $cb <Any-Motion> [list balloon::default_balloon $cb motion %X %Y \
$gc]
bind $cb <Any-Leave> [list balloon::default_balloon $cb leave %X %Y]
pack $cb -anchor w
incr i
}
if {$i == 0} {
MessageDlg ${gw}_err -aspect 50000 -icon info \
-message [::msgcat::mc "No users in roster..."] -type user \
-buttons ok -default 0 -cancel 0
return
}
$gw draw
}
proc muc::invitation {gw jid} {
global invite_muc
set sf [$gw getframe].sw.sf
set choices {}
foreach gc [array names invite_muc] {
if {$invite_muc($gc)} {
lappend choices $gc
}
}
destroy $gw
set items {}
foreach choice $choices {
lappend items \
[jlib::wrapper:createtag invite \
-vars [list to $choice] \
-subtags [list [jlib::wrapper:createtag reason \
-chdata [format [::msgcat::mc \
"Please join %s"] \
$jid]]]]
}
if {$items != {}} {
message::send_msg $jid -type normal \
-xlist [list [jlib::wrapper:createtag x \
-vars [list xmlns $::NS(gc_user)] \
-subtags $items]]
}
}