xep-0183: implemented receipt request responses in chat. Fixed caps in presence

diff --git a/bin/bf_xmpp.tcl b/bin/bf_xmpp.tcl
index 4eea4f7a4a373cf35d333d6c4ba3f0f732100209..82b7233c5390748cd61bba11ce46da0eba448f5c 100644 (file)
--- a/bin/bf_xmpp.tcl
+++ b/bin/bf_xmpp.tcl
@@ -76,15 +76,24 @@ proc ::xmppplugin::connect {callback args} {
         [namespace code [list OnPresenceChange $context]]
 
     # Discovery support
-    $xmpp(jlib) disco registeridentity client pc Bullfrog
     foreach feature {jabber:client jabber:iq:last jabber:iq:time \
-                         jabber:iq:version jabber:x:event} {
+                         jabber:iq:version jabber:x:event urn:xmpp:receipts} {
         jlib::disco::registerfeature $feature
     }
+    $xmpp(jlib) disco registeridentity client pc Bullfrog
 
-    #$xmpp(jlib) caps register ? ? ?
     set [set xmpp(jlib)]::AppContext $context
     Callback $context init
+
+    set e_color \
+        [list [wrapper::createtag "identity"  \
+                   -attrlist [list category hierarchy type leaf name "color"]]\
+             [wrapper::createtag "feature" \
+                  -attrlist [list var "urn:tkchat:color"]]]
+    $xmpp(jlib) caps register color $e_color [list urn:tkchat:color]
+    #$xmpp(jlib) caps register time $e_time [list time urn:tkchat:color]
+    $xmpp(jlib) register_presence_stanza [get_caps $context] -type available
+
     set xmpp(jid) [jlib::joinjid $xmpp(-username) $xmpp(-server) $xmpp(-resource)]
     $xmpp(jlib) connect init
     $xmpp(jlib) connect configure -defaultresource $xmpp(-resource)
@@ -174,7 +183,7 @@ proc ::xmppplugin::post {ctx channel msg} {
         if {$thread eq ""} {set thread [uuid::uuid generate] }
     }
 
-    if {[catch {dict get $xmll(opts) $channel -chatstate} chatstate]} {
+    if {[catch {dict get $xmpp(opts) $channel -chatstate} chatstate]} {
         set chatstate active
     }
 
@@ -219,12 +228,16 @@ proc ::xmppplugin::Version {ctx} {
     return $ver
 }
 
+# Generates a jlib xmllist containing the xep-0115 caps data for this
+# version of this application. Should be constant per instance.
 proc ::xmppplugin::get_caps {ctx} {
+    upvar #0 $ctx xmpp
     foreach {name ver os} [split [Version $ctx] :] break
+    set exts [$xmpp(jlib) caps getexts] ;# registered on startup
     set caps [wrapper::createtag c -attrlist \
                   [list xmlns "http://jabber.org/protocol/caps" \
-                       node "http://tkchat.tclers.tk/$name/caps" \
-                       ver $ver ext {color time}]]
+                       node "http://tkchat.tcl.tk/$name/caps" \
+                       ver $ver ext $exts]]
     return $caps
 }
 
@@ -274,7 +287,7 @@ proc ::xmppplugin::OnConnect {ctx jlib type args} {
         ok {
             Callback $ctx connect
             $jlib send_presence
-            $jlib send_presence -priority 2 -extras [list [get_caps $ctx]]
+            $jlib send_presence -priority 2 -show available
             $jlib roster send_get -command [list [namespace origin OnRosterGet] $ctx]
             if {$xmpp(-autoconnect) && $xmpp(-channel) ne {}} {
                 Log $ctx "Attempting to join $xmpp(-channel)"
@@ -617,6 +630,7 @@ proc ::xmppplugin::OnMessage2 {ctx jlib xmldata} {
                    [wrapper::getfirstchildwithtag $xmldata thread]]]
     set chatstate [wrapper::gettag \
              [wrapper::getfirstchildwithxmlns $xmldata http://jabber.org/protocol/chatstates]]
+    set receipt [wrapper::getchildswithtagandxmlns $xmldata request urn:xmpp:receipts]
 
     foreach x [wrapper::getchildswithtag $xmldata x] {
         switch -exact -- [wrapper::getattribute $x xmlns] {
@@ -695,6 +709,14 @@ proc ::xmppplugin::OnMessage2 {ctx jlib xmldata} {
                 }
             }
             # if chatstate stuff -- display somehow
+
+            # xep-0183: receipt notification 
+            if {[llength $receipt] > 0 && [info exists a(id)]} {
+                $xmpp(jlib) send_message $a(from) -id $a(id) -type $a(type) \
+                    -xlist [list [wrapper::createtag received \
+                                      -attrlist {xmlns urn:xmpp:receipts}]]
+            }
+
             if {[llength $body] > 0} {
                 Callback $ctx chat $a(from) $nick \
                     [wrapper::getcdata [lindex $body 0]] normal
@@ -715,8 +737,10 @@ proc ::xmppplugin::OnMessage2 {ctx jlib xmldata} {
             }
             set p [list -date $time -subject $subject]
             if {$thread ne {}} {lappend p -thread $thread}
-            lappend p -body [wrapper::getcdata [lindex $body 0]]
-            eval [linsert $p 0 Callback $ctx message $a(to) $from]
+            lappend p -body [set bodydata [wrapper::getcdata [lindex $body 0]]]
+            if {[string length $body] > 0 || [string length $subject] > 0} {
+                eval [linsert $p 0 Callback $ctx message $a(to) $from]
+            }
         }
         headline {
             Callback $ctx chat $a(to) $a(from) \
@@ -739,7 +763,6 @@ proc ::xmppplugin::OnMessage2 {ctx jlib xmldata} {
     }
 }
 
-
 proc ::xmppplugin::query_user {Chat user what} {
     upvar #0 $Chat ctx
     upvar #0 $ctx(xmpp) xmpp
@@ -765,6 +788,16 @@ proc ::xmppplugin::query_user {Chat user what} {
     return
 }
 
+proc ::xmppplugin::SendReceipt {Chat} {
+    lappend xlist [wrapper::createtag received \
+                       -attrlist {xmlns urn:xmpp:receipts}]
+    set margs [list -type $chat(type) -xlist $xlist]
+    if {![catch {set thread [dict get $xmpp(opts) $chat(channel) -thread]}]} {
+        lappend margs -thread $thread
+    }
+    eval [linsert $margs 0 $xmpp(jlib) send_message $chat(channel)]
+}
+
 package provide xmppplugin $::xmppplugin::version
 
 # -------------------------------------------------------------------------