[Tkabber-dev] r1465 - in trunk/tkabber: . jabberlib tclxml

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Sat Jul 5 19:46:59 MSD 2008


Author: sergei
Date: 2008-07-05 19:46:58 +0400 (Sat, 05 Jul 2008)
New Revision: 1465

Modified:
   trunk/tkabber/ChangeLog
   trunk/tkabber/jabberlib/wrapper.tcl
   trunk/tkabber/tclxml/sgmlparser.tcl
Log:
	* jabberlib/wrapper.tcl, tclxml/sgmlparser.tcl: Fixed parsing XMLNS
	  prefixes for tag attributes. Now they are replaced by XMLNS URI both
	  when tDOM or internal parser are used.


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2008-07-03 06:42:29 UTC (rev 1464)
+++ trunk/tkabber/ChangeLog	2008-07-05 15:46:58 UTC (rev 1465)
@@ -1,3 +1,9 @@
+2008-07-05  Sergei Golovan  <sgolovan at nes.ru>
+
+	* jabberlib/wrapper.tcl, tclxml/sgmlparser.tcl: Fixed parsing XMLNS
+	  prefixes for tag attributes. Now they are replaced by XMLNS URI both
+	  when tDOM or internal parser are used.
+
 2008-07-03  Sergei Golovan  <sgolovan at nes.ru>
 
 	* plugins/general/caps.tcl: Added forgotten node in disco#info reply

Modified: trunk/tkabber/jabberlib/wrapper.tcl
===================================================================
--- trunk/tkabber/jabberlib/wrapper.tcl	2008-07-03 06:42:29 UTC (rev 1464)
+++ trunk/tkabber/jabberlib/wrapper.tcl	2008-07-05 15:46:58 UTC (rev 1465)
@@ -117,30 +117,40 @@
     }
 
     set newvarlist {}
-    foreach {attr val} $varlist {
-        set l [::split $attr :]
-        if {[llength $l] > 1} {
-            set xmlns [join [lrange $l 0 end-1] :]
-            if {$xmlns == "http://www.w3.org/XML/1998/namespace"} {
-                set xmlns xml
-            }
-            set attr $xmlns:[lindex $l end]
-        }
-        lappend newvarlist $attr $val
-    }
+    set xmlns ""
 
     foreach {attr val} $args {
 	switch -- $attr {
-	    -namespace {lappend newvarlist xmlns $val}
+	    -namespace {
+		set xmlns $val
+		lappend newvarlist xmlns $xmlns
+	    }
 	}
     }
 
     set idx [string last : $tagname]
     if {$idx >= 0} {
-	lappend newvarlist xmlns [string range $tagname 0 [expr {$idx - 1}]]
 	set tagname [string range $tagname [expr {$idx + 1}] end]
+	set xmlns [string range $tagname 0 [expr {$idx - 1}]]
+	lappend newvarlist xmlns $xmlns
     }
 
+    foreach {attr val} $varlist {
+        set l [::split $attr :]
+        if {[llength $l] > 1} {
+            set axmlns [join [lrange $l 0 end-1] :]
+            if {$axmlns == $xmlns} {
+                set attr [lindex $l end]
+	    } else {
+		if {$axmlns == "http://www.w3.org/XML/1998/namespace"} {
+		    set axmlns xml
+		}
+		set attr $axmlns:[lindex $l end]
+	    }
+        }
+        lappend newvarlist $attr $val
+    }
+
     if {$wrapper($id,stack) == {}} {
 	set wrapper($id,level1tag) $tagname
 	uplevel #0 "$wrapper($id,streamstartcmd) [list $newvarlist]"

Modified: trunk/tkabber/tclxml/sgmlparser.tcl
===================================================================
--- trunk/tkabber/tclxml/sgmlparser.tcl	2008-07-03 06:42:29 UTC (rev 1464)
+++ trunk/tkabber/tclxml/sgmlparser.tcl	2008-07-05 15:46:58 UTC (rev 1465)
@@ -1010,8 +1010,28 @@
 	set ns [list -namespace [lindex $state(defaultNSURI) end]]
     }
 
+    # Prepend attributes with XMLNS URI
+    set attr1 {}
+    foreach {key val} $attr {
+	if {[regexp {([^:]+):(.*)$} $key discard prefix key1]} {
+	    set nsspec [lsort -dictionary -decreasing [array names namespaces $prefix,*]]
+	    if {[llength $nsspec]} {
+		set nsuri $namespaces([lindex $nsspec 0])
+		lappend attr1 $nsuri:$key1 $val
+	    } else {
+		# HACK: ignore undeclared namespace
+		# TODO: investigate it
+		#uplevel #0 $options(-errorcommand) \
+		#	[list namespaceundeclared "no namespace declared for prefix \"$prefix\" in attribute $key"]
+		lappend attr1 $key $val
+	    }
+	} else {
+	    lappend attr1 $key $val
+	}
+    }
+
     # Invoke callback
-    set code [catch {uplevel #0 $options(-elementstartcommand) [list $tag $attr] $empty $ns $nsdecls} msg]
+    set code [catch {uplevel #0 $options(-elementstartcommand) [list $tag $attr1] $empty $ns $nsdecls} msg]
     return -code $code -errorinfo $::errorInfo $msg
 }
 



More information about the Tkabber-dev mailing list