[Tkabber-dev] r949 - trunk/tkabber

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Fri Feb 16 23:53:07 MSK 2007


Author: sergei
Date: 2007-02-16 23:53:05 +0300 (Fri, 16 Feb 2007)
New Revision: 949

Modified:
   trunk/tkabber/ChangeLog
   trunk/tkabber/utils.tcl
Log:
	* utils.tcl: Recent changes trigger unknown bug in Tcl/Tk from
	  Debian sarge, so reverted them.


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2007-02-16 07:08:51 UTC (rev 948)
+++ trunk/tkabber/ChangeLog	2007-02-16 20:53:05 UTC (rev 949)
@@ -1,3 +1,8 @@
+2007-02-16  Sergei Golovan  <sgolovan at nes.ru>
+
+	* utils.tcl: Recent changes trigger unknown bug in Tcl/Tk from
+	  Debian sarge, so reverted them.
+
 2007-02-14  Sergei Golovan  <sgolovan at nes.ru>
 
 	* ifacetk/iface.tcl, userinfo.tcl: Unbound mousewheel bindings from

Modified: trunk/tkabber/utils.tcl
===================================================================
--- trunk/tkabber/utils.tcl	2007-02-16 07:08:51 UTC (rev 948)
+++ trunk/tkabber/utils.tcl	2007-02-16 20:53:05 UTC (rev 949)
@@ -1,59 +1,44 @@
 # $Id$
 
+proc user_from_jid {jid} {
+    set user $jid
+    regexp {(.*@.*)/.*} $jid temp user
+
+    return $user
+}
+
 proc node_and_server_from_jid {jid} {
-    set b [string first / $jid]
-    if {$b < 0} { 
-	return $jid
-    } else {
-	string range $jid 0 [incr b -1]
-    }
+    set nas $jid
+    regexp {([^/]*)/.*} $jid temp nas
+
+    return $nas
 }
 
 proc server_from_jid {jid} {
-    set a [string first @ $jid]
-    set b [string first / $jid]
+    set serv $jid
+    regexp {([^/]*)/.*} $jid temp serv
+    regexp {[^@]*@(.*)} $serv temp serv
 
-    if {$a < 0} {
-	if {$b < 0} {
-	    return $jid
-	} else {
-	    string range $jid 0 [incr b -1]
-	}
-    } else {
-	if {$b < 0} {
-	    string range $jid [incr a] end
-	} elseif {$a >= $b} {
-	    string range $jid 0 [incr b -1]
-	} else {
-	    string range $jid [incr a] [incr b -1]
-	}
-    }
+    return $serv
 }
 
 proc resource_from_jid {jid} {
-    set b [string first / $jid]
-    if {$b < 0} {
-	return
-    } else {
-	string range $jid [incr b] end
-    }
+    set resource ""
+    regexp {[^/]*/(.*)} $jid temp resource
+
+    return $resource
 }
 
 proc node_from_jid {jid} {
-    set a [string first @ $jid]
-    if {$a < 0} {
-	return
-    } else {
-	set b [string first / $jid]
-	if {$b >= 0 && $a > $b} {
-	    return
-	} else {
-	    string range $jid 0 [incr a -1]
-	}
-    }
+    set node ""
+    regexp {^([^@/]*)@.*} $jid temp node
+
+    return $node
 }
 
+
 proc tolower_node_and_domain {jid} {
+    
     set nas [string tolower [node_and_server_from_jid $jid]]
     set resource [resource_from_jid $jid]
 
@@ -62,6 +47,7 @@
     } else {
 	return $nas
     }
+    
 }
 
 # my_jid - returns JID for inclusion in queries. If the recipient



More information about the Tkabber-dev mailing list