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

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Sun Jan 12 17:12:03 MSK 2014


Author: sergei
Date: 2014-01-12 17:12:02 +0400 (Sun, 12 Jan 2014)
New Revision: 2055

Modified:
   trunk/tkabber/ChangeLog
   trunk/tkabber/gpgme.tcl
   trunk/tkabber/messages.tcl
   trunk/tkabber/plugins/chat/logger.tcl
   trunk/tkabber/plugins/general/message_archive.tcl
   trunk/tkabber/presence.tcl
Log:
	* plugins/chat/logger.tcl, plugins/general/message_archive.tcl:
	  added another way of signalling if a message should not be logged.

	* presence.tcl: Store presence xml:lang attribute.

	* messages.tcl, gpgme.tcl: Introduced new rewrite_outgoing_message_hook
	  and moved GPG encryption and signing to this hook.


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2014-01-07 17:19:42 UTC (rev 2054)
+++ trunk/tkabber/ChangeLog	2014-01-12 13:12:02 UTC (rev 2055)
@@ -1,3 +1,13 @@
+2014-01-12  Sergei Golovan  <sgolovan at nes.ru>
+
+	* plugins/chat/logger.tcl, plugins/general/message_archive.tcl:
+	  added another way of signalling if a message should not be logged.
+
+	* presence.tcl: Store presence xml:lang attribute.
+
+	* messages.tcl, gpgme.tcl: Introduced new rewrite_outgoing_message_hook
+	  and moved GPG encryption and signing to this hook.
+
 2014-01-07  Sergei Golovan  <sgolovan at nes.ru>
 
 	* chats.tcl, ifacetk/roster.tcl, muc.tcl, plugins/general/remote.tcl,

Modified: trunk/tkabber/gpgme.tcl
===================================================================
--- trunk/tkabber/gpgme.tcl	2014-01-07 17:19:42 UTC (rev 2054)
+++ trunk/tkabber/gpgme.tcl	2014-01-12 13:12:02 UTC (rev 2055)
@@ -1184,6 +1184,34 @@
 
 #############################################################################
 
+proc ::ssj::sign_encrypt_body {vxlib vto vid vtype vsubject vbody verr vthread vx} {
+    upvar 2 $vxlib xlib
+    upvar 2 $vto to
+    upvar 2 $vbody body
+    upvar 2 $vx x
+
+    if {![info exists body]} return
+
+    foreach tag [list signed encrypted] {
+        if {[catch { ssj::${tag}:output $xlib $body $to } cdata]} {
+            debugmsg message "ssj::${tag}:output: $cdata"
+            return
+        }
+
+        if {![string equal $cdata ""]} {
+            lappend x [::xmpp::xml::create x -xmlns $::NS($tag) -cdata $cdata]
+            if {[string equal $tag encrypted]} {
+                set body [::msgcat::mc "This message is encrypted."]
+            }
+        }
+    }
+    return
+}
+
+hook::add rewrite_outgoing_message_hook ::ssj::sign_encrypt_body
+
+#############################################################################
+
 proc ::ssj::userinfo {tab xlib jid editable} {
     variable signed
 

Modified: trunk/tkabber/messages.tcl
===================================================================
--- trunk/tkabber/messages.tcl	2014-01-07 17:19:42 UTC (rev 2054)
+++ trunk/tkabber/messages.tcl	2014-01-12 13:12:02 UTC (rev 2055)
@@ -493,59 +493,53 @@
 }
 
 proc message::send_msg {xlib to args} {
-    array set params [list -xlist {}]
-    array set params $args
+    set x {}
+    foreach {key val} $args {
+	switch -- $key {
+	    -from    { set from $val }
+	    -type    { set type $val }
+	    -id      { set id $val }
+	    -subject { set subject $val }
+	    -thread  { set thread $val }
+	    -body    { set body $val }
+	    -error   { set err $val }
+	    -xlist   { set x $val }
+	}
+    }
 
-    set command [list ::xmpp::sendMessage $xlib $to]
-    set xs $params(-xlist)
-    unset params(-xlist)
-
-    if {[info exists params(-body)]} {
-        set log_body $params(-body)
-        foreach tag [list signed encrypted] {
-            if {[cequal [info commands ::ssj::${tag}:output] ""]} {
-                continue
-            }
-
-            if {[catch { ssj::${tag}:output $xlib $params(-body) $to } cdata]} {
-                debugmsg message "ssj::${tag}:output: $cdata"
-                return [list error ssj]
-            }
-
-            if {![cequal $cdata ""]} {
-                lappend xs [::xmpp::xml::create x \
-                                -xmlns jabber:x:$tag -cdata $cdata]
-                if {[cequal $tag encrypted]} {
-                    set params(-body) [::msgcat::mc "This message is encrypted."]
-                }
-            }
-        }
+    if {[info exists body]} {
+        set log_body $body
     } else {
         set log_body ""
     }
-    if {[info exists params(-subject)]} {
-        set log_subject $params(-subject)
+    if {[info exists subject]} {
+        set log_subject $subject
     } else {
         set log_subject ""
     }
-    if {[llength $xs] > 0} {
-        lappend command -xlist $xs
-    }
 
-    foreach {k v} [array get params] {
-        lappend command $k $v
-    }
+    hook::run rewrite_outgoing_message_hook \
+	      xlib to id type subject body err thread x
 
+    set command [list ::xmpp::sendMessage $xlib $to]
+
+    if {[info exists from]}    { lappend command -from $from }
+    if {[info exists type]}    { lappend command -type $type }
+    if {[info exists id]}      { lappend command -id $id }
+    if {[info exists subject]} { lappend command -subject $subject }
+    if {[info exists thread]}  { lappend command -thread $thread }
+    if {[info exists body]}    { lappend command -body $body }
+    if {[info exists err]}     { lappend command -error $err }
+    if {[info exists x]}       { lappend command -xlist $x }
+
     eval $command
 
-    if {(![info exists params(-type)] || $params(-type) == "normal") && \
-	    $log_body != ""} {
-        ::message_archive::log_message \
-	    [connection_jid $xlib] \
-            $to $log_subject $log_body $xs
+    if {(![info exists type] || $type == "normal") && $log_body != ""} {
+        ::message_archive::log_message [connection_jid $xlib] \
+				       $to $log_subject $log_body $x
     }
 
-    return [list success $xs]
+    return [list success $x]
 }
 
 proc message::jiddropcmd {target source pos op type data} {

Modified: trunk/tkabber/plugins/chat/logger.tcl
===================================================================
--- trunk/tkabber/plugins/chat/logger.tcl	2014-01-07 17:19:42 UTC (rev 2054)
+++ trunk/tkabber/plugins/chat/logger.tcl	2014-01-12 13:12:02 UTC (rev 2055)
@@ -218,7 +218,8 @@
 	
 	# Don't log message if this 'empty' tag is present. It indicates
 	# messages history in chat window.
-	if {[string equal $tag ""] && [string equal $xmlns tkabber:x:nolog]} {
+	if {[string equal $tag ""] && \
+		([string equal $xmlns tkabber:x:nolog] || [string equal $xmlns tkabber:x:dontlog])} {
 	    return
 	}
     }

Modified: trunk/tkabber/plugins/general/message_archive.tcl
===================================================================
--- trunk/tkabber/plugins/general/message_archive.tcl	2014-01-07 17:19:42 UTC (rev 2054)
+++ trunk/tkabber/plugins/general/message_archive.tcl	2014-01-12 13:12:02 UTC (rev 2055)
@@ -33,6 +33,14 @@
 proc ::message_archive::log_message {from to subject body x} {
     variable archive_file
 
+    foreach el $x {
+	::xmpp::xml::split $el tag xmlns attrs cdata subels
+
+	if {[string equal $tag ""] && [string equal $xmlns tkabber:x:dontlog]} {
+	    return
+	}
+    }
+
     set seconds [::xmpp::xml::getAttr [::xmpp::delay::parse $x] seconds]
     set ts [clock format $seconds -format "%Y%m%dT%H%M%S"]
 

Modified: trunk/tkabber/presence.tcl
===================================================================
--- trunk/tkabber/presence.tcl	2014-01-07 17:19:42 UTC (rev 2054)
+++ trunk/tkabber/presence.tcl	2014-01-12 13:12:02 UTC (rev 2055)
@@ -55,6 +55,9 @@
 		    -error {
 			set presence(error,$xlib,$from) $val
 		    }
+		    -lang {
+			set presence(lang,$xlib,$from) $val
+		    }
 		}
 	    }
 
@@ -79,6 +82,7 @@
 		    -status   {set presence(status,$xlib,$from)   $val}
 		    -priority {set presence(priority,$xlib,$from) $val}
 		    -show     {set presence(show,$xlib,$from)     $val}
+		    -lang     {set presence(lang,$xlib,$from)     $val}
 		}
 	    }
 	    



More information about the Tkabber-dev mailing list