# $Id$
proc user_from_jid {jid} {
set user $jid
regexp {(.*@.*)/.*} $jid temp user
return $user
}
proc node_and_server_from_jid {jid} {
set nas $jid
regexp {([^/]*)/.*} $jid temp nas
return $nas
}
proc server_from_jid {jid} {
set serv $jid
regexp {([^/]*)/.*} $jid temp serv
regexp {[^@]*@(.*)} $jid temp serv
return $serv
}
proc resource_from_jid {jid} {
set resource ""
regexp {[^/]*/(.*)} $jid temp resource
return $resource
}
proc node_from_jid {jid} {
set node ""
regexp {([^@]*)@.*} $jid temp node
#debugmsg utils "Node($jid) = $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]
if {![cequal $resource ""]} {
return $nas/$resource
} else {
return $nas
}
}
proc win_id {prefix key} {
global wins
if {![info exists wins(seq,$prefix)]} {
set wins(seq,$prefix) 0
}
if {![info exists wins(key,$prefix,$key)]} {
set idx $wins(seq,$prefix)
set wins(key,$prefix,$key) ".${prefix}_$idx"
incr wins(seq,$prefix)
}
return $wins(key,$prefix,$key)
}
proc jid_to_tag {jid} {
variable jidtag
variable tagjid
if {[info exists jidtag($jid)]} {
return $jidtag($jid)
} else {
set tag [join [lmatch -regexp [split $jid {}] \
{^[[:alpha:]]$}] {}][random 1000000000]
while {[info exists tagjid($tag)]} {
set tag [join [lmatch -regexp [split $jid {}] \
{^[[:alpha:]]$}] {}][random 1000000000]
}
set jidtag($jid) $tag
set tagjid($tag) $jid
return $tag
}
}
proc tag_to_jid {tag} {
variable tagjid
if {[info exists tagjid($tag)]} {
return $tagjid($tag)
} else {
error "Unknown tag $tag"
}
}
proc double% {str} {
regsub -all % $str %% res
return $res
}
proc get_lang {} {
set prefs [::msgcat::mcpreferences]
lindex $prefs [expr {[llength $prefs] - 1}]
}