# $Id$
namespace eval userinfo {
}
proc userinfo::w_from_jid {jid} {
return [win_id userinfo $jid]
#regsub -all \\. $jid | allowed_name
#return .userinfo_$allowed_name
}
proc userinfo::pack_frame {w text} {
set tf [TitleFrame $w -borderwidth 2 -relief groove -text $text]
pack $tf -fill both -expand yes
return [$tf getframe]
}
proc userinfo::pack_entry {w g row name text} {
global font
label $g.l$name -text $text
entry $g.$name -textvariable userinfo::userinfo($name,$w) \
-state disabled -borderwidth 0 -font $font
grid $g.l$name -row $row -column 0 -sticky e
grid $g.$name -row $row -column 1 -sticky we
grid columnconfig $g 1 -weight 1 -minsize 0
#grid rowconfig $g $row -weight 1 -minsize 0
}
proc userinfo::open {jid} {
global font
variable userinfo
set w [w_from_jid $jid]
if {[winfo exists $w]} {
focus -force $w
return
}
toplevel $w
wm title $w "$jid info"
NoteBook $w.tab
pack $w.tab -expand yes -fill both
set personal [$w.tab insert end personal -text Personal]
set n [pack_frame $personal.n Name]
pack_entry $w $n 0 fn "Full Name:"
pack_entry $w $n 1 family "Family Name:"
pack_entry $w $n 2 name Name:
pack_entry $w $n 3 middle "Middle Name:"
pack_entry $w $n 4 prefix Prefix:
pack_entry $w $n 5 suffix Suffix:
pack_entry $w $n 6 nickname Nickname:
set c [pack_frame $personal.info Information]
pack_entry $w $c 0 email E-mail:
pack_entry $w $c 1 url "Web Site:"
pack_entry $w $c 2 jabberid "JID:"
pack_entry $w $c 3 uid "UID:"
set phones [$w.tab insert end phones -text Phones]
set t [pack_frame $phones.tel "Telephone numbers"]
pack_entry $w $t 0 tel_home Home:
pack_entry $w $t 1 tel_work Work:
pack_entry $w $t 2 tel_voice Voice:
pack_entry $w $t 3 tel_fax Fax:
pack_entry $w $t 4 tel_pager Pager:
pack_entry $w $t 5 tel_msg "Message Recorder:"
pack_entry $w $t 6 tel_cell Cell(?):
pack_entry $w $t 7 tel_video Video:
pack_entry $w $t 8 tel_bbs BBS:
pack_entry $w $t 9 tel_modem Modem:
pack_entry $w $t 10 tel_isdn ISDN:
pack_entry $w $t 11 tel_pcs PCS(?):
pack_entry $w $t 12 tel_pref Preferred:
set location [$w.tab insert end location -text Location]
set l [pack_frame $location.address Address]
pack_entry $w $l 0 address Address:
pack_entry $w $l 1 address2 "Address 2:"
pack_entry $w $l 2 city City:
pack_entry $w $l 3 state "State:"
pack_entry $w $l 4 pcode "Postal Code:"
pack_entry $w $l 5 country Country:
set g [pack_frame $location.geo "Geographical position"]
pack_entry $w $g 0 geo_lat Latitude:
pack_entry $w $g 1 geo_lon Longitude:
set organization [$w.tab insert end organization -text Organization]
set d [pack_frame $organization.details Details]
pack_entry $w $d 0 orgname Name:
pack_entry $w $d 1 orgunit Unit:
set p [pack_frame $organization.personal Personal]
pack_entry $w $p 0 title Title:
pack_entry $w $p 1 role Role:
set about [$w.tab insert end about -text About]
set b [pack_frame $about.bday Birthday]
pack_entry $w $b 0 bday Birthday:
set a [pack_frame $about.about About]
text $a.text -font $font
#-state disabled
fill_user_description $a.text userinfo(desc,$w)
pack $a.text -fill both -expand yes
pack $a -fill both -expand yes
trace variable userinfo(desc,$w) w \
[list userinfo::fill_user_description $a.text userinfo(desc,$w)]
$w.tab raise personal
if {1} {
set client [$w.tab insert end client -text "Client Info"]
set c [pack_frame $client.client Client]
pack_entry $w $c 0 clientname Client:
pack_entry $w $c 1 clientversion Version:
pack $c -fill both -expand yes
set o [pack_frame $client.computer Computer]
pack_entry $w $o 0 os OS:
pack_entry $w $o 1 time Time:
pack $o -fill both -expand yes
# FIX -to ...
jlib::send_iq get \
[jlib::wrapper:createtag query \
-vars [list xmlns jabber:iq:version]] \
-to [get_jid_of_user $jid] \
-command [list userinfo::parse_iqversion $jid]
jlib::send_iq get \
[jlib::wrapper:createtag query \
-vars [list xmlns jabber:iq:time]] \
-to [get_jid_of_user $jid] \
-command [list userinfo::parse_iqtime $jid]
}
jlib::send_iq get \
[jlib::wrapper:createtag vCard \
-vars [list prodid {-//HandGen//NONSGML vGen v1.0//EN} \
version 2.0 xmlns vcard-temp]] \
-to $jid -command [list userinfo::parse_vcard $jid]
}
proc userinfo::fill_user_description {txt descvar args} {
variable userinfo
if {[info exists $descvar] && [winfo exists $txt]} {
$txt delete 0.0 end
$txt insert 0.0 [set $descvar]
}
}
proc userinfo::parse_vcard {jid res child} {
debugmsg userinfo "$res $child"
if {![cequal $res OK]} {
return
}
jlib::wrapper:splitxml $child tag vars isempty chdata children
foreach item $children {
parse_vcard_item $jid $item
}
}
proc userinfo::parse_vcard_item {jid child} {
variable userinfo
set w [w_from_jid $jid]
jlib::wrapper:splitxml $child tag vars isempty chdata children
# TODO:
# VERSION, ---
# PHOTO?, ---
# ADR?,
# LABEL?,
# TEL?, +?
# EMAIL?,
# MAILER?,
# TZ?,
# GEO?,
# LOGO?,
# AGENT?,
# CATEGORIES?,
# NOTE?,
# PRODID?,
# REV?,
# SORT-STRING?,
# SOUND?,
# UID?,
# URL?,
# CLASS?,
# KEY?,
# DESC?
switch -- $tag {
FN {set userinfo(fn,$w) $chdata}
NICKNAME {set userinfo(nickname,$w) $chdata}
N {parse_vcard_n_item $jid $children}
ADR {parse_vcard_adr_item $jid $children}
TEL {parse_vcard_tel_item $jid $children}
TEL {set userinfo(telephone,$w) $chdata}
EMAIL {set userinfo(email,$w) $chdata}
JABBERID {set userinfo(jabberid,$w) $chdata}
GEO {parse_vcard_geo_item $jid $children}
ORG {parse_vcard_org_item $jid $children}
TITLE {set userinfo(title,$w) $chdata}
ROLE {set userinfo(role,$w) $chdata}
BDAY {set userinfo(bday,$w) $chdata}
UID {set userinfo(uid,$w) $chdata}
URL {set userinfo(url,$w) $chdata}
DESC {set userinfo(desc,$w) $chdata}
default {debugmsg userinfo "Unknown vCard tag $tag"}
}
}
proc userinfo::parse_vcard_n_item {jid items} {
variable userinfo
set w [w_from_jid $jid]
foreach item $items {
jlib::wrapper:splitxml $item tag vars isempty chdata children
switch -- $tag {
FAMILY {set userinfo(family,$w) $chdata}
GIVEN {set userinfo(name,$w) $chdata}
MIDDLE {set userinfo(middle,$w) $chdata}
PREFIX {set userinfo(prefix,$w) $chdata}
SUFFIX {set userinfo(suffix,$w) $chdata}
default {debugmsg userinfo "Unknown vCard <N/> subtag $tag"}
}
}
}
proc userinfo::parse_vcard_adr_item {jid items} {
variable userinfo
set w [w_from_jid $jid]
foreach item $items {
jlib::wrapper:splitxml $item tag vars isempty chdata children
# TODO:
# HOME?,
# WORK?,
# POSTAL?,
# PARCEL?,
# (DOM | INTL)?,
# PREF?,
# POBOX?,
# LOCALITY?,
# CTRY?
switch -- $tag {
STREET {set userinfo(address,$w) $chdata}
EXTADD {set userinfo(address2,$w) $chdata}
LOCALITY {set userinfo(city,$w) $chdata}
REGION {set userinfo(state,$w) $chdata}
PCODE {set userinfo(pcode,$w) $chdata}
COUNTRY {set userinfo(country,$w) $chdata}
default {debugmsg userinfo "Unknown vCard <ADR/> subtag $tag"}
}
}
}
proc userinfo::parse_vcard_tel_item {jid items} {
variable userinfo
set w [w_from_jid $jid]
set types {}
foreach item $items {
jlib::wrapper:splitxml $item tag vars isempty chdata children
# TODO:
# HOME?,
# WORK?,
# VOICE?,
# FAX?,
# PAGER?,
# MSG?,
# CELL?,
# VIDEO?,
# BBS?,
# MODEM?,
# ISDN?,
# PCS?,
# PREF?,
# NUMBER
switch -- $tag {
HOME {lappend types home}
WORK {lappend types work}
VOICE {lappend types voice}
FAX {lappend types fax}
PAGER {lappend types pager}
MSG {lappend types msg}
CELL {lappend types cell}
VIDEO {lappend types video}
BBS {lappend types bbs}
MODEM {lappend types modem}
ISDN {lappend types isdn}
PCS {lappend types pcs}
PREF {lappend types pref}
NUMBER {
foreach t $types {
set userinfo(tel_$t,$w) $chdata
}
}
default {debugmsg userinfo "Unknown vCard <TEL/> subtag $tag"}
}
}
}
proc userinfo::parse_vcard_geo_item {jid items} {
variable userinfo
set w [w_from_jid $jid]
foreach item $items {
jlib::wrapper:splitxml $item tag vars isempty chdata children
switch -- $tag {
LAT {set userinfo(geo_lat,$w) $chdata}
LON {set userinfo(geo_lon,$w) $chdata}
default {debugmsg userinfo "Unknown vCard <ORG/> subtag $tag"}
}
}
}
proc userinfo::parse_vcard_org_item {jid items} {
variable userinfo
set w [w_from_jid $jid]
# TODO: <!ELEMENT ORG (ORGNAME, ORGUNIT*)>
foreach item $items {
jlib::wrapper:splitxml $item tag vars isempty chdata children
switch -- $tag {
ORGNAME {set userinfo(orgname,$w) $chdata}
ORGUNIT {set userinfo(orgunit,$w) $chdata}
default {debugmsg userinfo "Unknown vCard <ORG/> subtag $tag"}
}
}
}
proc userinfo::parse_iqversion {jid res child} {
debugmsg userinfo "$res $child"
if {![cequal $res OK]} {
return
}
jlib::wrapper:splitxml $child tag vars isempty chdata children
if {[cequal [jlib::wrapper:getattr $vars xmlns] jabber:iq:version]} {
userinfo::parse_iqversion_item $jid $children
}
}
proc userinfo::parse_iqversion_item {jid items} {
variable userinfo
set w [w_from_jid $jid]
foreach item $items {
jlib::wrapper:splitxml $item tag vars isempty chdata children
switch -- $tag {
name {set userinfo(clientname,$w) $chdata}
version {set userinfo(clientversion,$w) $chdata}
os {set userinfo(os,$w) $chdata}
default {debugmsg userinfo "Unknown iq:version tag '$tag'"}
}
}
}
proc userinfo::parse_iqtime {jid res child} {
debugmsg userinfo "$res $child"
if {![cequal $res OK]} {
return
}
jlib::wrapper:splitxml $child tag vars isempty chdata children
if {[cequal [jlib::wrapper:getattr $vars xmlns] jabber:iq:time]} {
userinfo::parse_iqtime_item $jid $children
}
}
proc userinfo::parse_iqtime_item {jid items} {
variable userinfo
set w [w_from_jid $jid]
foreach item $items {
jlib::wrapper:splitxml $item tag vars isempty chdata children
switch -- $tag {
utc {}
display {set userinfo(time,$w) $chdata}
tz {}
default {debugmsg userinfo "Unknown iq:version tag '$tag'"}
}
}
}