[Tkabber-dev] r1801 - in trunk/tkabber: . plugins/chat

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Sat May 9 16:07:38 MSD 2009


Author: sergei
Date: 2009-05-09 16:07:37 +0400 (Sat, 09 May 2009)
New Revision: 1801

Modified:
   trunk/tkabber/ChangeLog
   trunk/tkabber/plugins/chat/chatstate.tcl
   trunk/tkabber/plugins/chat/events.tcl
Log:
	* plugins/chat/events.tcl, plugins/chat/chatstate.tcl:: Fixed
	  processing incoming events which were ignored because they are sent
	  as normal messages. Also, don't send events to people not in roster
	  or in a groupchat.

	* plugins/chat/chatstate.tcl: Added sending 'paused' event (thanks to
	  quantifier at jabster.pl).


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2009-05-07 09:52:51 UTC (rev 1800)
+++ trunk/tkabber/ChangeLog	2009-05-09 12:07:37 UTC (rev 1801)
@@ -1,3 +1,13 @@
+2009-05-09  Sergei Golovan  <sgolovan at nes.ru>
+
+	* plugins/chat/events.tcl, plugins/chat/chatstate.tcl:: Fixed
+	  processing incoming events which were ignored because they are sent
+	  as normal messages. Also, don't send events to people not in roster
+	  or in a groupchat.
+
+	* plugins/chat/chatstate.tcl: Added sending 'paused' event (thanks to
+	  quantifier at jabster.pl).
+
 2009-05-07  Sergei Golovan  <sgolovan at nes.ru>
 
 	* joingrdialog.tcl: Added another room JID normalization.

Modified: trunk/tkabber/plugins/chat/chatstate.tcl
===================================================================
--- trunk/tkabber/plugins/chat/chatstate.tcl	2009-05-07 09:52:51 UTC (rev 1800)
+++ trunk/tkabber/plugins/chat/chatstate.tcl	2009-05-09 12:07:37 UTC (rev 1801)
@@ -1,6 +1,6 @@
 # $Id$
 #
-# Chat State Notifications (XEP-0085) (only <active/> and <composing/>) support.
+# Chat State Notifications (XEP-0085) support.
 #
 
 namespace eval chatstate {
@@ -14,13 +14,32 @@
     disco::register_feature $::NS(chatstate)
 }
 
+proc chatstate::is_reply_allowed {xlib jid} {
+    variable options
+
+    if {!$options(enable)} {
+	return 0
+    }
+
+    if {[get_jid_status $xlib $jid] == "unavailable"} {
+	return 0
+    }
+
+    set chatid [chat::chatid $xlib [::xmpp::jid::stripResource $jid]]
+    if {[chat::is_groupchat $chatid]} {
+	return 1
+    }
+
+    return [roster::is_trusted $xlib $jid]
+}
+
 # Workaround a bug in JIT, which responds with error to chatstate
 # events without a body
 proc chatstate::ignore_error \
      {xlib from id type is_subject subject body err thread priority x} {
     switch -- $type/$id {
 	error/chatstate {
-	    return stop
+	    return -code break
 	}
     }
 }
@@ -29,28 +48,33 @@
 
 proc chatstate::flush_composing {chatid user body type} {
     variable chatstate
+    variable event_afterid
 
     set chatstate(composing,$chatid) 1
+    set chatstate(paused,$chatid) 0
+    if {[info exists event_afterid(pause,$chatid)]} {
+	after cancel $event_afterid(pause,$chatid)
+	unset event_afterid(pause,$chatid)
+    }
 }
 
 hook::add chat_send_message_hook \
-    [list [namespace current]::chatstate::flush_composing] 91
+	  [namespace current]::chatstate::flush_composing 91
 
-proc chatstate::process_x {chatid from type body xs} {
-    if {$type == "chat"} {
-	foreach x $xs {
-	    ::xmpp::xml::split $x tag xmlns attrs cdata subels
-	    switch -- $xmlns \
-		$::NS(chatstate) {
-		    return [process_x_chatstate \
-				$chatid $from $type $body $x]
-		}
-	}
+proc chatstate::process_message \
+	{xlib from id type is_subject subject body err thread priority xs} {
+    set chatid [chat::chatid $xlib $from]
+
+    foreach x $xs {
+	::xmpp::xml::split $x tag xmlns attrs cdata subels
+	switch -- $xmlns \
+	    $::NS(chatstate) {
+		return [process_x_chatstate $chatid $from $type $body $x]
+	    }
     }
 }
 
-hook::add draw_message_hook \
-    [list [namespace current]::chatstate::process_x] 1
+hook::add process_message_hook [namespace current]::chatstate::process_message
 
 proc chatstate::process_x_chatstate {chatid from type body x} {
     variable options
@@ -86,10 +110,11 @@
 }
 
 proc chatstate::change_status {chatid status} {
+    global usetabbar
     variable event_afterid
 
-    if {[info exists event_afterid($chatid)]} {
-	after cancel $event_afterid($chatid)
+    if {[info exists event_afterid(clear,$chatid)]} {
+	after cancel $event_afterid(clear,$chatid)
     }
     set cw [chat::winid $chatid]
     set jid [chat::get_jid $chatid]
@@ -118,22 +143,29 @@
 	}
     }
 
-    if {$stext != "" && $::usetabbar} {set_status $stext}
+    if {$stext != "" && $usetabbar} {
+	set_status $stext
+    }
+
     if {![winfo exists $cw]} return
+
     $cw.status.event configure -text $text
-    set event_afterid($chatid) \
+    set event_afterid(clear,$chatid) \
 	[after 10000 [list [namespace current]::clear_status $chatid]]
 }
 
 proc chatstate::clear_status {chatid} {
     set cw [chat::winid $chatid]
+
     if {![winfo exists $cw]} return
+
     $cw.status.event configure -text ""
 }
 
 proc chatstate::event_composing {iw sym} {
     variable options
     variable chatstate
+    variable event_afterid
 
     if {$sym == ""} return
 
@@ -141,34 +173,95 @@
     set chatid [chat::winid_to_chatid $cw]
 
     if {![chat::is_chat $chatid]} return
+
+    if {![info exists chatstate(windowactive,$chatid)] || \
+	    ($chatstate(windowactive,$chatid) == 0)} return
+
+    set empty [expr {[$iw count -chars 0.0 "end-1c"] == 0}]
+
+    if {[info exists event_afterid(pause,$chatid)]} {
+	after cancel $event_afterid(pause,$chatid)
+	unset event_afterid(pause,$chatid)
+    }
+
+    set paused [expr {[info exists chatstate(paused,$chatid)] && \
+		      $chatstate(paused,$chatid)}]
+    if {!$empty} {
+	set event_afterid(pause,$chatid) \
+		[after 6400 [list [namespace current]::send_paused $chatid]]
+
+	if {($sym == "<Delete>" || $sym == "<BackSpace>") && !$paused} return
+    }
+
     if {[info exists chatstate(composing,$chatid)] && \
-	    !$chatstate(composing,$chatid)} return
-    if {!$options(enable)} return
+	    ($chatstate(composing,$chatid) == $empty) && \
+	    !$paused} return
 
     set xlib [chat::get_xlib $chatid]
     set jid [chat::get_jid $chatid]
 
-    set chatstate(composing,$chatid) 0
+    set chatstate(composing,$chatid) $empty
+    set chatstate(paused,$chatid) 0
 
-    if {[get_jid_status $xlib $jid] == "unavailable"} return
+    if {![is_reply_allowed $xlib $jid]} return
 
-    lappend xlist [::xmpp::xml::create composing -xmlns $::NS(chatstate)]
+    if {$empty} {
+	lappend xlist [::xmpp::xml::create active -xmlns $::NS(chatstate)]
+    } else {
+	lappend xlist [::xmpp::xml::create composing -xmlns $::NS(chatstate)]
+    }
 
-    ::xmpp::sendMessage $xlib $jid -id chatstate -xlist $xlist
+    ::xmpp::sendMessage $xlib $jid -type chat -id chatstate -xlist $xlist
 }
 
+proc chatstate::send_paused {chatid} {
+    variable options
+    variable chatstate
+    variable event_afterid
+
+    if {[info exists event_afterid(pause,$chatid)]} {
+	after cancel $event_afterid(pause,$chatid)
+	unset event_afterid(pause,$chatid)
+    }
+
+    if {![info exists chatstate(windowactive,$chatid)] || \
+	    ($chatstate(windowactive,$chatid) == 0)} return
+
+    if {![info exists chatstate(composing,$chatid)] || \
+	    $chatstate(composing,$chatid)} return
+
+    if {![chat::is_chat $chatid]} return
+
+    set chatstate(paused,$chatid) 1
+
+    set xlib [chat::get_xlib $chatid]
+    set jid [chat::get_jid $chatid]
+
+    if {![is_reply_allowed $xlib $jid]} return
+
+    lappend xlist [::xmpp::xml::create paused -xmlns $::NS(chatstate)]
+
+    ::xmpp::sendMessage $xlib $jid -type chat -id chatstate -xlist $xlist
+}
+
 proc chatstate::setup_ui {chatid type} {
     variable chatstate
 
     if {![chat::is_chat $chatid]} return
 
     set cw [chat::winid $chatid]
+    set input [chat::input_win $chatid]
 
     set l $cw.status.event
     if {![winfo exists $l]} {
 	label $l
 	pack $l -side left
     }
+
+    bind $input <Key-Delete> \
+	 [namespace code [list event_composing %W <Delete>]]
+    bind $input <Key-BackSpace> \
+	 [namespace code [list event_composing %W <BackSpace>]]
 }
 
 hook::add text_on_keypress_hook [namespace current]::chatstate::event_composing
@@ -180,48 +273,65 @@
 }
 
 hook::add chat_send_message_hook \
-    [namespace current]::chatstate::clear_status_on_send
+	  [namespace current]::chatstate::clear_status_on_send
 
 proc chatstate::make_xlist {varname chatid user id body type} {
     variable options
     variable chatstate
     upvar 2 $varname var
 
-    if {!$options(enable) || $type != "chat"} {
+    if {$type != "chat"} {
 	return
     }
 
+    set xlib [chat::get_xlib $chatid]
+    set jid [chat::get_jid $chatid]
+
     set chatstate(windowactive,$chatid) 1
 
+    if {![is_reply_allowed $xlib $jid]} return
+
     lappend var [::xmpp::xml::create active -xmlns $::NS(chatstate)]
     return
 }
 
 hook::add chat_send_message_xlist_hook \
-    [namespace current]::chatstate::make_xlist
+	  [namespace current]::chatstate::make_xlist
 
 proc chatstate::send_gone {chatid} {
     variable options
     variable chatstate
+    variable event_afterid
 
+    if {[info exists event_afterid(pause,$chatid)]} {
+	after cancel $event_afterid(pause,$chatid)
+	unset event_afterid(pause,$chatid)
+    }
+
+    if {[info exists event_afterid(clear,$chatid)]} {
+	after cancel $event_afterid(clear,$chatid)
+	unset event_afterid(clear,$chatid)
+    }
+
     if {![info exists chatstate(windowactive,$chatid)] || \
 	    ($chatstate(windowactive,$chatid) == 0)} return
 
     if {![chat::is_chat $chatid]} return
-    if {!$options(enable)} return
 
     set xlib [chat::get_xlib $chatid]
     set jid [chat::get_jid $chatid]
 
-    unset chatstate(windowactive,$chatid)
+    catch {unset chatstate(windowactive,$chatid)}
+    catch {unset chatstate(composing,$chatid)}
+    catch {unset chatstate(paused,$chatid)}
 
-    if {[get_jid_status $xlib $jid] == "unavailable"} return
+    if {![is_reply_allowed $xlib $jid]} return
 
     lappend xlist [::xmpp::xml::create gone -xmlns $::NS(chatstate)]
 
-    ::xmpp::sendMessage $xlib $jid -id chatstate -xlist $xlist
+    ::xmpp::sendMessage $xlib $jid -type chat -id chatstate -xlist $xlist
 }
 
 hook::add close_chat_post_hook \
-    [namespace current]::chatstate::send_gone 10
+	  [namespace current]::chatstate::send_gone 10
 

Modified: trunk/tkabber/plugins/chat/events.tcl
===================================================================
--- trunk/tkabber/plugins/chat/events.tcl	2009-05-07 09:52:51 UTC (rev 1800)
+++ trunk/tkabber/plugins/chat/events.tcl	2009-05-09 12:07:37 UTC (rev 1801)
@@ -14,7 +14,41 @@
     disco::register_feature $::NS(event)
 }
 
-proc events::process_x {check_request chatid from type body xs} {
+proc events::is_reply_allowed {xlib jid} {
+    variable options
+
+    if {!$options(enable)} {
+	return 0
+    }
+
+    if {[get_jid_status $xlib $jid] == "unavailable"} {
+	return 0
+    }
+
+    set chatid [chat::chatid $xlib [::xmpp::jid::stripResource $jid]]
+    if {[chat::is_groupchat $chatid]} {
+	return 1
+    }
+
+    return [roster::is_trusted $xlib $jid]
+}
+
+proc events::process_message \
+	{xlib from id type is_subject subject body err thread priority xs} {
+    set chatid [chat::chatid $xlib $from]
+
+    foreach x $xs {
+	::xmpp::xml::split $x tag xmlns attrs cdata subels
+	switch -- $xmlns \
+	    $::NS(event) {
+		return [process_x_event 0 $chatid $from $type $body $x]
+	    }
+    }
+}
+
+hook::add process_message_hook [namespace current]::events::process_message
+
+proc events::process_x {chatid from type body xs} {
     variable chats
     variable options
 
@@ -23,19 +57,14 @@
 	    ::xmpp::xml::split $x tag xmlns attrs cdata subels
 	    switch -- $xmlns \
 		$::NS(event) {
-		    return [process_x_event \
-				$check_request $chatid $from $type $body $x]
+		    return [process_x_event 1 $chatid $from $type $body $x]
 		}
 	}
     }
 }
 
-hook::add draw_message_hook \
-    [list [namespace current]::events::process_x 0] 0
+hook::add draw_message_hook [namespace current]::events::process_x 6
 
-hook::add draw_message_hook \
-    [list [namespace current]::events::process_x 1] 6
-
 proc events::process_x_event {check_request chatid from type body x} {
     variable options
     variable events
@@ -74,7 +103,7 @@
 	    # with real messages
 	    return
 	} else {
-	    return stop
+	    return -code break
 	}
     } elseif {!$id && $check_request} {
 	clear_status $chatid
@@ -82,10 +111,8 @@
 	set events(displayed,$chatid) $displayed
 	set events(composing,$chatid) $composing
 
-	if {!$options(enable)} return
+	if {![is_reply_allowed $xlib $jid]} return
 
-	if {[get_jid_status $xlib $jid] == "unavailable"} return
-
 	lappend eventtags [::xmpp::xml::create id \
 			       -cdata $::chat::chats(id,$chatid)]
 	if {$delivered} {
@@ -170,10 +197,8 @@
 
     set events(displayed,$chatid) 0
 
-    if {!$options(enable)} return
+    if {![is_reply_allowed $xlib $jid]} return
 
-    if {[get_jid_status $xlib $jid] == "unavailable"} return
-
     lappend eventtags [::xmpp::xml::create id \
 			   -cdata $::chat::chats(id,$chatid)]
     lappend eventtags [::xmpp::xml::create displayed]
@@ -205,10 +230,8 @@
 
     set events(composing,$chatid) 0
 
-    if {!$options(enable)} return
+    if {![is_reply_allowed $xlib $jid]} return
 
-    if {[get_jid_status $xlib $jid] == "unavailable"} return
-
     lappend eventtags [::xmpp::xml::create id \
 			   -cdata $::chat::chats(id,$chatid)]
     lappend eventtags [::xmpp::xml::create composing]
@@ -243,16 +266,19 @@
 }
 
 hook::add chat_send_message_hook \
-    [namespace current]::events::clear_status_on_send
+	  [namespace current]::events::clear_status_on_send
 
 proc events::make_xlist {varname chatid user id body type} {
     variable options
     upvar 2 $varname var
 
-    if {!$options(enable) || $type != "chat"} {
-	return
-    }
+    if {$type != "chat"} return
 
+    set xlib [chat::get_xlib $chatid]
+    set jid [chat::get_jid $chatid]
+
+    if {![is_reply_allowed $xlib $jid]} return
+
     lappend events [::xmpp::xml::create offline]
     lappend events [::xmpp::xml::create delivered]
     lappend events [::xmpp::xml::create displayed]
@@ -263,6 +289,5 @@
     return
 }
 
-hook::add chat_send_message_xlist_hook \
-    [namespace current]::events::make_xlist
+hook::add chat_send_message_xlist_hook [namespace current]::events::make_xlist
 



More information about the Tkabber-dev mailing list