# $Id$
namespace eval chat {
array set opened {}
set chats(groupchats) {}
}
set chat_width 50
set chat_height 18
plugins::load chat-plugins
proc chat::get_nick {from type} {
variable chats
set nick $from
switch -- $type {
chat {
#regexp {(.*)@.*} $from temp nick
set groupid [node_and_server_from_jid $from]
if {[lsearch -exact $chats(groupchats) $groupid] >= 0} {
if {[conference::is_v2 $groupid]} {
set nick [conference::get_nick $from]
} else {
set nick [resource_from_jid $from]
}
} else {
set nick [node_from_jid $from]
}
}
groupchat {
set groupid [node_and_server_from_jid $from]
if {[conference::is_v2 $groupid]} {
set nick [conference::get_nick $from]
} else {
set nick [resource_from_jid $from]
}
}
default {
}
}
return $nick
}
proc chat::winid {name} {
global w
# FIX
regsub -all \\. $name | allowed_name
return $w.chat_$allowed_name
}
proc client:message {from type subject body err thread priority x} {
debugmsg chats "MESSAGE: $from; $type; $subject; $body; $err;\
$thread; $priority; $x"
chat::process_message $from $type $subject $body $err $thread $priority $x
}
proc chat::process_message {from type subject body err thread priority x} {
global font
variable opened
set from [tolower_node_and_domain $from]
set chatid $from
switch -- $type {
normal {
message::show_dlg $from $subject $body $thread $priority $x
return
}
chat {
}
groupchat {
#regexp {(.*)/.*} $from temp chatid
set chatid [node_and_server_from_jid $from]
if {![cequal $subject ""]} {
set_subject $chatid $subject
}
}
error {
#set body "Error [lindex $err 0]: [lindex $err 1]\n$body"
set body "Error [lindex $err 0]: [lindex $err 1]"
}
default {
debugmsg chats "MESSAGE: UNSUPPORTED message type '$type'"
}
}
chat::open_window $chatid $type
chat::add_message $chatid $from $type $body $x
}
plugins::require_hook open_chat_pre_hook
plugins::require_hook open_chat_post_hook
proc chat::open_window {chatid type} {
global w font chat_width chat_height loginconf
variable opened
variable chats
set cw [winid $chatid]
if {[winfo exists $cw]} {
if {$type == "chat"} {
#raise $cw
}
return
}
plugins::run_hook open_chat_pre_hook $chatid $type
set chats(type,$chatid) $type
set chats(ourjid,$chatid) [get_our_jid $chatid $type]
debugmsg chats "OURJID: $chats(ourjid,$chatid)"
lappend chats(opened) $chatid
set opened($chatid) $cw
#debugmsg chats $cw
#debugmsg chats [array names opened_chats]
#debugmsg chats $opened_chats($chatid)
set chatname [roster::itemconfig [roster::find_jid $chatid] -name]
if {$chatname != ""} {
set titlename $chatname
set tabtitlename $titlename
} else {
set titlename $chatid
#set tabtitlename [node_from_jid $chatid]
if {[lsearch -exact $chats(groupchats) $chatid] >= 0} {
set tabtitlename [node_from_jid $chatid]
} else {
set tabtitlename [get_nick $chatid chat]
}
}
add_win $cw -title "Chat with $titlename" \
-tabtitle $tabtitlename \
-raisecmd "focus [list $cw.input]
tab_set_updated [list $cw] 0"
#toplevel $cw
#-class Tkabber.$chatid
#wm deiconify $cw
#wm title $cw "Chat with $chatid"
if {[string equal $type chat]} {
frame $cw.status
pack $cw.status -side top -fill x
label $cw.status.icon -image [get_user_status $chatid]
pack $cw.status.icon -side left
label $cw.status.description -text $chatid -font $font
pack $cw.status.description -side left
} else {
frame $cw.status
pack $cw.status -side top -fill x
label $cw.status.lsubject -text Subject: -font $font
pack $cw.status.lsubject -side left
entry $cw.status.subject -font $font
pack $cw.status.subject -side left -fill x -expand yes
bind $cw.status.subject <Return> [list chat::change_subject $chatid]
}
text $cw.input -width $chat_width -height 3 -font $font -wrap word
pack $cw.input -fill x -side bottom
set chats(inputwin,$chatid) $cw.input
if {[string equal $type groupchat]} {
lappend chats(groupchats) $chatid
PanedWindow $cw.pw -side bottom
pack $cw.pw -fill both -expand yes
set cf [$cw.pw add -weight 4 -minsize 100]
set uw [$cw.pw add -weight 0 -minsize 32]
set chats(userswin,$chatid) $uw.users
roster::create $uw.users -width 3c -popup roster::group_popup_menu
pack $uw.users -fill both -side right -expand yes
global grouproster
set grouproster(users,$chatid) {}
set grouproster(redraw,$chatid) 0
roster::addline $uw.users group Users users
client:presence $chatid "" "" {}
} else {
set cf $cw
}
set chats(chatwin,$chatid) $cf.chat
text $cf.chat -yscrollcommand [list $cf.chatscroll set] \
-width $chat_width -height $chat_height -font $font -wrap word
scrollbar $cf.chatscroll -command [list $cf.chat yview]
pack $cf.chatscroll -fill y -side right
pack $cf.chat -expand yes -fill both -side left
$cf.chat tag configure they -foreground red3
$cf.chat tag configure me -foreground blue
$cf.chat tag configure server_lab -foreground green
$cf.chat tag configure server -foreground violet
$cf.chat tag configure err -foreground red
$cf.chat configure -state disabled
focus $cw.input
bind $cw.input <Shift-Key-Return> { }
bind $cw.input <Key-Return> \
[join [list [list chat::send_message $cw $chatid \
$loginconf(user) $type] \
break] \n]
bind $cw <Destroy> [list chat::close_window $chatid]
plugins::run_hook open_chat_post_hook $chatid $type
### FOR TESTING
#client:presence talks@localhost/asd "" "" {}
#client:presence talks@localhost/ĘŁ× "" "" -show dnd
#client:presence talks@localhost/qwe "" "" -show chat
#client:presence talks@localhost/ert "" "" -show away
#client:presence talks@localhost/asd unavailable "" ""
}
proc chat::close_window {chatid} {
global chat_width chat_height
variable opened
variable chats
set cw [winid $chatid]
if {[info exists opened($chatid)]} {
unset opened($chatid)
set idx [lsearch $chats(opened) $chatid]
set chats(opened) [lreplace $chats(opened) $idx $idx]
debugmsg chats $chats(opened)
if {$chats(type,$chatid) == "groupchat"} {
jlib::send_presence \
-to $chatid/[get_our_groupchat_nick $chatid] \
-type unavailable
client:presence $chatid unavailable "" {}
}
destroy $cw
}
}
proc chat::users_win {chatid} {
variable chats
return $chats(userswin,$chatid)
}
proc chat::chat_win {chatid} {
variable chats
return $chats(chatwin,$chatid)
}
proc chat::input_win {chatid} {
variable chats
return $chats(inputwin,$chatid)
}
plugins::require_hook chat_send_message
proc chat::send_message {cw chatid user type} {
set iw $cw.input
set body [$iw get 1.0 "end -1 chars"]
plugins::run_hook chat_send_message $chatid $user $body $type
$iw delete 1.0 end
}
plugins::require_hook draw_message_hook
proc chat::add_message {chatid from type body x} {
variable chats
set chatw [chat_win $chatid]
$chatw configure -state normal
plugins::run_hook draw_message_hook $chatid $from $type $body $x
if {![$chatw compare "end -1 chars linestart" == "end -1 chars"]} {
$chatw insert end "\n"
}
$chatw see end
$chatw configure -state disabled
set cw [winid $chatid]
tab_set_updated $cw 1
#update
}
proc chat::add_emoteiconed_text {chatid body defaulttag} {
#set notfirst 0
#set words [split $body { }]
set chatw [chat_win $chatid]
if {[clength $body] < 1024} {
set wordstart 0
for {set wordend 0} {$wordend<[clength $body]} {incr wordend} {
if {[ctype space [cindex $body $wordend]]} {
set word [crange $body $wordstart [expr $wordend-1]]
set wordstart [expr $wordend + 1]
if {[string length $word]} {
set image [emoteicons::get $word]
if {$image != ""} {
$chatw image create end -image $image
} else {
$chatw insert end $word $defaulttag
}
}
$chatw insert end [cindex $body $wordend]
}
}
set word [crange $body $wordstart [expr $wordend-1]]
if {[string length $word]} {
set image [emoteicons::get $word]
if {$image != ""} {
$chatw image create end -image $image
} else {
$chatw insert end $word $defaulttag
}
}
} else {
$chatw insert end $body $defaulttag
}
}
proc chat::open_to_user {user} {
set jid [get_jid_of_user $user]
if {[cequal $jid ""]} {
set jid $user
}
set cw [winid $jid]
if {[winfo exists $cw]} {
focus -force $cw.input
return
}
chat::open_window $jid chat
}
proc chat::change_presence {jid status} {
global grouproster
variable chats
variable opened
set group [node_and_server_from_jid $jid]
set nick [get_nick $jid groupchat]
if {[resource_from_jid $jid] == ""} {
return
}
if {[info exists opened($group)] && ![lcontain $chats(groupchats) $jid]} {
set cw $opened($group)
debugmsg chats "ST: $jid $status"
if {[cequal $status unavailable]} {
debugmsg chats "$jid UNAVAILABLE"
lvarpop grouproster(users,$group) \
[lsearch $grouproster(users,$group) $jid]
debugmsg chats "GR: $grouproster(users,$group)"
if {!$grouproster(redraw,$group)} {
set grouproster(redraw,$group) 1
after idle chat::redraw_roster $cw $group
}
} else {
set userswin [users_win $group]
if {![lcontain $grouproster(users,$group) $jid]} {
roster::addline $userswin jid $nick $jid
lappend grouproster(users,$group) $jid
set grouproster(status,$group,$jid) $status
if {!$grouproster(redraw,$group)} {
set grouproster(redraw,$group) 1
after idle chat::redraw_roster $cw $group
}
#redraw_roster $cw $group
}
set grouproster(status,$group,$jid) $status
roster::changeicon $userswin $jid $status
after idle chat::redraw_roster $cw $group
}
#roster:changeicon $w.users [user_from_jid $from] $status
}
set cw [winid $jid]
if {[winfo exists $cw]} {
if {![lcontain $chats(groupchats) $jid]} {
$cw.status.icon configure -image $status
}
}
}
proc chat::redraw_roster {cw group} {
global grouproster
set userswin [users_win $group]
set grouproster(users,$group) [lsort $grouproster(users,$group)]
roster::clear $userswin 0
roster::addline $userswin group Users users
foreach jid $grouproster(users,$group) {
set nick [get_nick $jid groupchat]
set status $grouproster(status,$group,$jid)
roster::addline $userswin jid $nick $jid
roster::changeicon $userswin $jid $status
}
set grouproster(redraw,$group) 0
roster::update_scrollregion $userswin
}
proc chat::get_our_jid {chatid type} {
variable chats
switch -- $type {
groupchat {
return $chatid/[get_our_groupchat_nick $chatid]
}
chat {
set groupid [node_and_server_from_jid $chatid]
if {[lsearch -exact $chats(groupchats) $groupid] >= 0} {
return $groupid/[get_our_groupchat_nick $groupid]
} else {
global loginconf
return \
${loginconf(user)}@$loginconf(server)/$loginconf(resource)
}
}
}
}
proc chat::set_subject {chatid subject} {
variable opened
set cw [winid $chatid]
if {[info exists opened($chatid)]} {
$cw.status.subject delete 0 end
$cw.status.subject insert 0 $subject
}
}
proc chat::change_subject {chatid} {
set cw [winid $chatid]
set subject [$cw.status.subject get]
jlib::send_msg $chatid -type groupchat -subject $subject \
-body "/me has changed the subject to: $subject"
}
proc chat::is_our_jid {chatid jid} {
variable chats
return [string equal $chats(ourjid,$chatid) $jid]
}