Tkabber

    grid $p.lregexp    -row 1 -column 0 -sticky e
    grid $p.regexp     -row 1 -column 1 -sticky ew

    focus $p.groupname
    $w draw
}






































###############################################################################

proc roster::add_group_custom_presence_menu {m connid name} {
    set mm [menu $m.custom_presence -tearoff 0]

    $mm add command -label [::msgcat::mc "Available"] \
	-command [list roster::send_custom_presence_group $connid $name available]

			\x1C " " \x1D " " \x1E " " \x1F " "} $text]
}

######################################################################
#
# This procedure converts (and returns) $xmldata to raw-XML
#
proc wrapper:createxml {xmldata args} {
    set xmlns jabber:client
    set prettyprint 0
    set level 0
    foreach {opt val} $args {
	switch -- $opt {
	    -xmlns { set xmlns $val }
	    -level { set level $val }
	    -prettyprint { set prettyprint $val }
	    default {
		return -code error "Bad option \"$opt\":\
		    must be one of -xmlns, -level or -prettyprint"
	    }
	}
    }

    set retext ""

    lassign $xmldata tagname vars subtags chdata



    if {$prettyprint && $level} {
	append retext [string repeat \t $level]
    }
    append retext "<$tagname"
    foreach {attr value} $vars {
	if {$attr == "xmlns"} {
	    if {$value == $xmlns} {
		continue
	    } else {
		set xmlns $value
	    }
	}
	append retext " $attr='[wrapper:xmlcrypt $value]'"
    }

    set no_chdata [expr {$chdata == ""}]
    if {$no_chdata && [llength $subtags] == 0} {
	append retext "/>"
	if {$prettyprint} { append retext \n }
	return $retext
    }

    append retext ">"

    if {!$no_chdata} {
	append retext [wrapper:xmlcrypt $chdata]
    } elseif {$prettyprint} {
	append retext \n
    }

    foreach subdata $subtags {
	append retext [wrapper:createxml $subdata -xmlns $xmlns \
	    -prettyprint $prettyprint -level [expr {$level + 1}]]
    }

    if {$prettyprint && $no_chdata && $level} {
	append retext [string repeat \t $level]
    }
    append retext "</$tagname>"
    if {$prettyprint && $level} { append retext \n }

    return $retext
}

######################################################################
#
# This proc creates (and returns) xmldata of tag $tagname, 

#
# This proc returns stream trailer
#
proc wrapper:streamtrailer {} {
    return "</stream:stream>"
}

# vim:ts=8:sw=4:sts=4:noet

* Reimplement restore logic so that roster contacts are always
  sent first.

* Probably rething the logic once more: in theory, it could be
  possible to populate roster with restored contacts w/o
  sending them to the server (which could be done independently,
  at any time). In this case we don't have to synchronize
  with restoring annotations.

* Gateways and "gated" contacts doesn't appear to have correct
  category/subtype -- investigate whether it's possible to
  use that heuristic mechs to get them on the fly as they're
  pushed from the server during the restoration process.

hook::add connected_hook [namespace current]::annotations::request_notes

proc annotations::process_notes {connid res child} {
    variable notes

    if {$res != "OK"} return

    free_notes $connid

    foreach xmldata $child {
	jlib::wrapper:splitxml $xmldata tag vars isempty cdata children

	if {[jlib::wrapper:getattr $vars xmlns] == $::NS(rosternotes)} {
	    foreach note $children {
		create_note $connid $note
	    }
	}
    }
}

proc annotations::create_note {connid xmldata args} {
    variable notes

    set merge 0
    foreach {opt val} $args {
	switch -- $opt {
	    -merge { set merge $val }
	    default {
		return -code error "Bad option \"$opt\":\
		    must be -merge"
	    }
	}
    }

    jlib::wrapper:splitxml $xmldata tag vars isempty cdata children

    set jid [jlib::wrapper:getattr $vars jid]
    set cdate [jlib::wrapper:getattr $vars cdate]
    set mdate [jlib::wrapper:getattr $vars mdate]

    if {![catch { scan_time $cdate } cdate]} {
	set cdate [clock seconds]
    }
    if {![catch { scan_time $mdate } mdate]} {
	set cdate [clock seconds]
    }

    if {!$merge || [more_recent $connid $jid $cdate $mdate]} {
	set notes($connid,jid,$jid)   $jid
	set notes($connid,cdate,$jid) $cdate
	set notes($connid,mdate,$jid) $mdate
	set notes($connid,note,$jid)  $cdata
	return 1
    } else {

	return 0
    }
}

proc annotations::scan_time {timestamp} {
    if {[regexp {(.*)T(.*)Z} $timestamp -> date time]} {
	return [clock scan "$date $time" -gmt true]
    } else {
	return [clock scan $timestamp -gmt true]
    }
}

proc annotations::more_recent {connid jid cdate mdate} {
    variable notes

    if {![info exists notes($connid,jid,$jid)]} {
	return 1
    } elseif {[info exists notes($connid,mdate,$jid)]} {
	return [expr {$mdate > $notes($connid,mdate,$jid)}]
    } elseif {[info exists notes($connid,cdate,$jid)]} {
	return [expr {$cdate > $notes($connid,cdate,$jid)}]
    } else {
	return 1
    }
}

proc annotations::cleanup_and_store_notes {connid} {
    variable notes

    set roster_jids {}
    foreach rjid [roster::get_jids $connid] {
	lappend roster_jids [node_and_server_from_jid $rjid]

	    catch { unset notes($connid,note,$jid) }
	}
    }

    store_notes $connid
}

proc annotations::serialize_notes {connid} {
    variable notes

    set notelist {}
    foreach idx [array names notes $connid,jid,*] {
	set jid $notes($idx)

	set vars [list jid $jid]

	    lappend notelist \
		[jlib::wrapper:createtag note \
		     -vars $vars \
		     -chdata $notes($connid,note,$jid)]
	}
    }

    jlib::wrapper:createtag storage \
	-vars [list xmlns $::NS(rosternotes)] \
	-subtags $notelist
}

proc annotations::store_notes {connid} {
    private::store [list [serialize_notes $connid]] \
	-command [list [namespace current]::store_notes_result $connid] \
	-connection $connid
}

proc annotations::store_notes_result {connid res child} {

    if {$res == "OK"} return

    $n.text configure -state disabled
    pack $sw -side top -fill both -expand yes
    pack $n -fill both -expand yes
}

hook::add userinfo_hook [namespace current]::annotations::note_page 40

# vim:ts=8:sw=4:sts=4:noet

# $Id$
# Export/import of the roster items using an XML file.
# This code provides basic framework for handling roster backup
# files and it's able to serialize/deserialize regular roster contacts.
# Hooks provided to facilitate implementations of storing/restoring
# other kinds of data logically pertaining to the roster
# such as conference bookmarks, annotations, etc.

namespace eval rosterbackup {
    global NS
    set NS(rosterbackup) http://tkabber.jabber.ru/contactlist

    hook::add connected_hook \
	[namespace current]::setup_import_export_menus
    hook::add disconnected_hook \
	[namespace current]::setup_import_export_menus
    hook::add finload_hook \
	[namespace current]::setup_import_export_menus

    hook::add serialize_roster_hook \
	[namespace current]::serialize_roster_contacts
    hook::add deserialize_roster_hook \
	[namespace current]::deserialize_roster_contacts

    hook::add roster_push_hook \
	[namespace current]::process_roster_push
}

###############################################################################

proc rosterbackup::setup_import_export_menus {args} {
    set emenu [.mainframe getmenu export_roster]
    set imenu [.mainframe getmenu import_roster]

    if {[winfo exists $emenu]} {
	destroy $emenu
    }
    menu $emenu -tearoff 0

    if {[winfo exists $imenu]} {
	destroy $imenu
    }
    menu $imenu -tearoff 0

    if {[jlib::connections] == {}} {
	.mainframe setmenustate export_roster disabled
	.mainframe setmenustate import_roster disabled
    } else {
	.mainframe setmenustate export_roster normal
	.mainframe setmenustate import_roster normal
    }

    foreach c [jlib::connections] {
	set jid [jlib::connection_jid $c]
	set label [format [::msgcat::mc "Roster of %s"] $jid]
	set ecommand [list [namespace current]::export_to_file $c]
	set icommand [list [namespace current]::import_from_file $c]
	$emenu add command -label $label -command $ecommand
	$imenu add command -label $label -command $icommand
    }
}

###############################################################################

proc rosterbackup::export_to_file {connid} {
    set filename [tk_getSaveFile \
		      -initialdir $::configdir \
		      -initialfile [jlib::connection_user $connid]-roster.xml \
		      -filetypes [list \
				      [list [::msgcat::mc "Roster Files"] \
					   .xml] \
				      [list [::msgcat::mc "All Files"] *]]]
    if {$filename == ""} return

    set fd [open $filename w]
    fconfigure $fd -encoding utf-8

    puts $fd {<?xml version="1.0" encoding="UTF-8"?>}
    puts $fd [serialize_roster $connid]

    close $fd
}

###############################################################################

proc rosterbackup::serialize_roster {connid} {
    global NS

    set subtags [list]
    hook::run serialize_roster_hook $connid #[info level] subtags

    jlib::wrapper:createxml [jlib::wrapper:createtag contactlist \
	    -vars [list xmlns $NS(rosterbackup)] -subtags $subtags] \
	-prettyprint 1
}

###############################################################################

proc rosterbackup::serialize_roster_contacts {connid level varName} {
    upvar $level $varName subtags

    set items [list]
    foreach jid [::roster::get_jids $connid] {
	set category [::roster::itemconfig $connid $jid -category]
	switch -- $category {
	    user -
	    gateway {
		lappend items [::roster::item_to_xml $connid $jid]
	    }
	}
    }

    lappend subtags [jlib::wrapper:createtag roster \
	-vars {xmlns jabber:iq:roster} \
	-subtags $items]
}

###############################################################################

proc rosterbackup::import_from_file {connid} {
    set filename [tk_getOpenFile \
		      -initialdir $::configdir \
		      -initialfile [jlib::connection_user $connid]-roster.xml \
		      -filetypes [list \
				      [list [::msgcat::mc "Roster Files"] \
					   .xml] \
				      [list [::msgcat::mc "All Files"] *]]]
    if {$filename == ""} return

    set fd [open $filename r]
    fconfigure $fd -encoding utf-8
    set xml [string trimleft [read $fd] [format %c 0xFEFF]] ;# strip BOM, if any
    close $fd

    deserialize_roster $connid $xml
}

###############################################################################

proc rosterbackup::deserialize_roster {connid data} {
    hook::run roster_deserializing_hook $connid

    set parser [jlib::wrapper:new "#" "#" \
	[list [namespace current]::parse_roster_xml $connid]]
    jlib::wrapper:elementstart $parser stream:stream {} {}
    jlib::wrapper:parser $parser parse $data
    jlib::wrapper:parser $parser configure -final 0
    jlib::wrapper:free $parser

    hook::run roster_deserialized_hook $connid
}

###############################################################################

proc rosterbackup::parse_roster_xml {connid data} {
    global NS

    jlib::wrapper:splitxml $data tag vars isempty cdata children

    if {![string equal $tag contactlist]} {
	return -code error "Bad root element \"$tag\":\
	    must be contactlist"
    }
    set xmlns [jlib::wrapper:getattr $vars xmlns]
    if {![string equal $xmlns $NS(rosterbackup)]} {
	return -code error "Bad root element namespace \"$xmlns\":\
	    must be \"$NS(rosterbackup)\""
    }

    foreach child $children {
	hook::run deserialize_roster_hook $connid $child
    }
}

###############################################################################

proc rosterbackup::deserialize_roster_contacts {connid data} {
    global NS
    variable sent

    jlib::wrapper:splitxml $data tag vars isempty cdata children

    if {![string equal $tag roster]} return
    set xmlns [jlib::wrapper:getattr $vars xmlns]
    if {![string equal $xmlns $NS(roster)]} {
	return -code error "Bad roster element namespace \"$xmlns\":\
	    must be \"$NS(roster)\""
    }

    array set existing {}
    foreach jid [::roster::get_jids $connid] {
	set existing($jid) {}
    }

    upvar 0 sent($connid,jids) jids
    set jids [list]
    set subtags [list]

    foreach child $children {
	set jid [get_item_jid $child]
	if {![info exists existing($jid)]} {
	    lappend jids $jid
	    lappend subtags $child
	}
    }

    if {[llength $subtags] > 0} {
	set status [namespace current]::sent($connid,status)
	set $status WAITING
	jlib::send_iq set \
	    [jlib::wrapper:createtag query \
		 -vars [list xmlns $NS(roster)] \
		 -subtags $subtags] \
	    -connection $connid
	vwait $status
	unset $status
    }
}

###############################################################################

proc rosterbackup::get_item_jid {data} {
    jlib::wrapper:splitxml $data ? vars ? ? ?
    jlib::wrapper:getattr $vars jid
}

###############################################################################

proc rosterbackup::process_roster_push {connid jid name groups subsc ask} {
    variable sent
    upvar 0 sent($connid,status) status
    upvar 0 sent($connid,jids) jids

    if {[info exists status]} {
	set ix [lsearch -exact $jids $jid]
	if {$ix >= 0} {
	    if {[llength $jids] == 1} {
		unset jids
		set status COMPLETE
	    } else {
		set jids [lreplace $jids $ix $ix]
	    }
	}
    }
}

# vim:ts=8:sw=4:sts=4:noet

# $Id$
# Support for backup/restore of "annotations" (XEP-0145)
# for roster items.
# Depends on: annotations.tcl, backup.tcl

namespace eval annobackup {
    # Should probably go after the roster contacts, so we set prio to 60:
    hook::add serialize_roster_hook \
	[namespace current]::serialize_annotations 60
    hook::add deserialize_roster_hook \
	[namespace current]::deserialize_annotations 60
}

###############################################################################

proc annobackup::serialize_annotations {connid level varName} {
    upvar $level $varName subtags
    global NS

    set xmldata [::plugins::annotations::serialize_notes $connid]

    lappend subtags [jlib::wrapper:createtag privstorage \
	-vars {xmlns jabber:iq:private} \
	-subtags [list $xmldata]]
}

###############################################################################

proc annobackup::deserialize_annotations {connid data} {
    global NS

    jlib::wrapper:splitxml $data tag vars isempty cdata children
    if {![string equal $tag privstorage]} return
    set xmlns [jlib::wrapper:getattr $vars xmlns]
    if {![string equal $xmlns $NS(private)]} {
	return -code error "Bad roster element namespace \"$xmlns\":\
	    must be \"$NS(private)\""
    }

    set updated 0

    foreach storage $children {
	jlib::wrapper:splitxml $storage ctag cvars cisempty ccdata cchildren
	if {![string equal $ctag storage]} return
	set xmlns [jlib::wrapper:getattr $cvars xmlns]
	if {![string equal $xmlns $NS(rosternotes)]} return
	
	foreach child $cchildren {
	    set added [::plugins::annotations::create_note \
		    $connid $child -merge yes]
	    set updated [expr {$updated || $added}]
	}
    }

    if {$updated} {
	::plugins::annotations::cleanup_and_store_notes $connid
    }
}

# vim:ts=8:sw=4:sts=4:noet

# $Id$
# Support for backup/restore of "roster bookmarks" to MUC rooms (XEP-0048, v1.0)
# Depends on: conferences.tcl, backup.tcl

namespace eval mucbackup {
    variable updated

    # Should probably go after the roster contacts, so we set prio to 70:
    hook::add serialize_roster_hook \
	[namespace current]::serialize_muc_bookmarks 70
    hook::add deserialize_roster_hook \
	[namespace current]::deserialize_muc_bookmarks 70
    hook::add roster_deserializing_hook \
	[namespace current]::prepare_deserialization
    hook::add roster_deserialized_hook \
	[namespace current]::push_bookmarks_to_roster
}

###############################################################################

proc mucbackup::serialize_muc_bookmarks {connid level varName} {
    upvar $level $varName subtags
    global NS

    foreach xmldata [::plugins::conferences::serialize_bookmarks $connid] {
	lappend subtags [jlib::wrapper:createtag privstorage \
	    -vars [list xmlns $NS(private)] \
	    -subtags [list $xmldata]]
    }
}

###############################################################################

proc mucbackup::prepare_deserialization {connid} {
    variable updated
    set updated($connid) 0
}

###############################################################################

proc mucbackup::deserialize_muc_bookmarks {connid data} {
    variable updated
    upvar 0 updated($connid) upd
    global NS

    jlib::wrapper:splitxml $data tag vars isempty cdata children
    if {![string equal $tag privstorage]} return
    set xmlns [jlib::wrapper:getattr $vars xmlns]
    if {![string equal $xmlns $NS(private)]} {
	return -code error "Bad roster element namespace \"$xmlns\":\
	    must be \"$NS(private)\""
    }

    foreach storage $children {
	jlib::wrapper:splitxml $storage ctag cvars cisempty ccdata cchildren
	if {![string equal $ctag storage]} return
	set xmlns [jlib::wrapper:getattr $cvars xmlns]
	switch -- $xmlns \
	    $NS(bookmarks) {
		foreach child $cchildren {
		    set added [::plugins::conferences::create_muc_bookmark \
			    $connid $child -merge yes]
		    set upd [expr {$upd || $added}]
		}
	    } \
	    $NS(tkabber:groups) {
		foreach child $cchildren {
		    set added [::plugins::conferences::create_muc_bmgroup \
			    $connid $child -merge yes]
		    set upd [expr {$upd || $added}]
		}
	    }
    }
}

###############################################################################

proc mucbackup::push_bookmarks_to_roster {connid} {
    variable updated

    if {$updated($connid)} {
	::plugins::conferences::push_bookmarks_to_roster $connid
	::plugins::conferences::store_bookmarks $connid
    }

    unset updated($connid)
}

# vim:ts=8:sw=4:sts=4:noet

}

hook::add connected_hook [namespace current]::conferences::request_bookmarks 20

proc conferences::process_bookmarks {connid res child} {
    variable bookmarks
    variable responds
    global NS

    if {$res != "OK"} return

    incr responds($connid)

    foreach ch $child {
	jlib::wrapper:splitxml $ch tag1 vars1 isempty1 cdata1 children1

	switch -- [jlib::wrapper:getattr $vars1 xmlns] \
	    $NS(bookmarks) {
		foreach bookmark $children1 {

		    create_muc_bookmark $connid $bookmark

		}








	    } \

















	    $NS(tkabber:groups) {
		foreach bookmark $children1 {

		    create_muc_bmgroup $connid $bookmark

		}

	    }











    }

    if {$responds($connid) < 2} return

    push_bookmarks_to_roster $connid
    after idle [list [namespace current]::autojoin_groups $connid]
}

proc conferences::create_muc_bookmark {connid xmldata args} {
    variable bookmarks

    set merge 0
    foreach {opt val} $args {
	switch -- $opt {
	    -merge { set merge $val }
	    default {
		return -code error "Bad option \"$opt\":\
		    must be -merge"
	    }
	}
    }

    jlib::wrapper:splitxml $xmldata btag bvars bisempty bcdata bchildren

    if {![string equal $btag conference]} { return 0 }

    set jid [string tolower [jlib::wrapper:getattr $bvars jid]]

    if {$merge && [info exists bookmarks($connid,jid,$jid)]} {
	return 0
    } else {
	set bookmarks($connid,jid,$jid) $jid

	set bookmarks($connid,name,$jid) [jlib::wrapper:getattr $bvars name]
	set bookmarks($connid,nick,$jid) ""
	set bookmarks($connid,password,$jid) ""
	if {![info exists bookmarks($connid,groups,$jid)]} {
	    set bookmarks($connid,groups,$jid) {}
	    set bookmarks($connid,hasgroups,$jid) 0
	} else {
	    set bookmarks($connid,hasgroups,$jid) 1
	}

	set autojoin [jlib::wrapper:getattr $bvars autojoin]
	switch -- $autojoin {
	    1 -
	    true { set bookmarks($connid,autojoin,$jid) 1 }
	    default { set bookmarks($connid,autojoin,$jid) 0 }
	}
	
	foreach bch $bchildren {
	    jlib::wrapper:splitxml \
		$bch tag2 vars2 isempty2 cdata2 children2
	    switch -- $tag2 {
		nick { set bookmarks($connid,nick,$jid) $cdata2 }
		password { set bookmarks($connid,password,$jid) $cdata2 }
	    }
	}
	return 1
    }
}

proc conferences::create_muc_bmgroup {connid xmldata args} {
    variable bookmarks

    set merge 0
    foreach {opt val} $args {
	switch -- $opt {
	    -merge { set merge $val }
	    default {
		return -code error "Bad option \"$opt\":\
		    must be -merge"
	    }
	}
    }

    jlib::wrapper:splitxml $xmldata btag bvars bisempty bcdata bchildren

    if {![string equal $btag conference]} return

    set jid [string tolower [jlib::wrapper:getattr $bvars jid]]

    set groups [list]
    foreach bch $bchildren {
	jlib::wrapper:splitxml $bch tag2 vars2 isempty2 cdata2 children2
	if {[string equal $tag2 group]} {
	    lappend groups $cdata2
	}
    }

    if {$merge && [info exists bookmarks($connid,jid,$jid)]
		&& $bookmarks($connid,hasgroups,$jid)} {
	return 0
    } else {
	set bookmarks($connid,groups,$jid) $groups
	set bookmarks($connid,hasgroups,$jid) 1
	return 1
    }
}

proc conferences::push_bookmarks_to_roster {connid} {
    variable bookmarks

    foreach idx [array names bookmarks $connid,jid,*] {
	set jid $bookmarks($idx)
	client:roster_push $connid $jid $bookmarks($connid,name,$jid) \
			   $bookmarks($connid,groups,$jid) \
			   bookmark ""
	roster::override_category_and_subtype $connid $jid conference ""
    }

}

###############################################################################
#
#   Store bookmarks
#

proc conferences::serialize_bookmarks {connid} {
    variable bookmarks

    set bookmarklist {}
    set grouplist {}
    foreach idx [array names bookmarks $connid,jid,*] {
	set jid $bookmarks($idx)
	set name $bookmarks($connid,name,$jid)

				-chdata $group]
	}
	lappend grouplist [jlib::wrapper:createtag conference \
			       -vars $vars \
			       -subtags $groups]
    }

    list [jlib::wrapper:createtag storage \
	    -vars [list xmlns $::NS(bookmarks)] \
	    -subtags $bookmarklist] \



	[jlib::wrapper:createtag storage \
	    -vars [list xmlns $::NS(tkabber:groups)] \
	    -subtags $grouplist]
}

proc conferences::store_bookmarks {connid} {
    foreach item [serialize_bookmarks $connid] {
	private::store [list $item] \
	    -command [list [namespace current]::store_bookmarks_result $connid] \
	    -connection $connid
    }
}

proc conferences::store_bookmarks_result {connid res child} {

    if {$res == "OK"} return

    if {[winfo exists .store_bookmarks_error]} {

    set bookmarks($connid,jid,$jid) $jid
    set bookmarks($connid,name,$jid) $name
    set bookmarks($connid,nick,$jid) $nick
    set bookmarks($connid,password,$jid) $password
    set bookmarks($connid,autojoin,$jid) $autojoin
    set bookmarks($connid,groups,$jid) $groups
    set bookmarks($connid,hasgroups,$jid) 1

    # TODO should we remove $jid from the roster if it is here?
    client:roster_push $connid $jid $name $groups bookmark ""
    roster::override_category_and_subtype $connid $jid conference ""
    store_bookmarks $connid
}

    catch { unset bookmarks($connid,jid,$jid) }
    catch { unset bookmarks($connid,name,$jid) }
    catch { unset bookmarks($connid,nick,$jid) }
    catch { unset bookmarks($connid,password,$jid) }
    catch { unset bookmarks($connid,autojoin,$jid) }
    catch { unset bookmarks($connid,groups,$jid) }
    catch { unset bookmarks($connid,hasgroups,$jid) }

    store_bookmarks $connid

    return stop
}

hook::add roster_remove_item_hook \

	}
    }
}

hook::add disco_node_menu_hook \
	  [namespace current]::conferences::disco_node_menu_setup 50


# vim:ts=8:sw=4:sts=4:noet

    if {[llength $args] == 1} {
	lassign $args attr
	switch -- $attr {
	    -group    {set param group}
	    -name     {set param name}
	    -subsc    {set param subsc}
	    -ask      {set param ask}
	    -category {
		return [lindex [get_category_and_subtype $connid $jid] 0]
	    }
	    -subtype  {
		return [lindex [get_category_and_subtype $connid $jid] 1]
	    }
	    -isuser   {
		return [cequal [lindex [get_category_and_subtype $connid $jid] 0] "user"]
	    }
	    default   {
		return -code error "Bad option \"$attr\":\
		    must be one of: -group, -name, -subsc, -ask,\
		    -category, -subtype or -isuser"
	    }
	}
	if {[info exists roster($param,$connid,$jid)]} {
	    return $roster($param,$connid,$jid)
	} else {
	    return ""
	}
    } else {
	foreach {attr val} $args {
	    switch -- $attr {
		-group    {set param group}
		-name     {set param name}
		-subsc    {set param subsc}
		-ask      {set param ask}
		-category {
		    override_category $connid $jid $val
		    continue
		}
		-subtype  {
		    override_subtype $connid $jid $val
		    continue
		}
		default   {return -code error "Illegal option"}
	    }
	    set roster($param,$connid,$jid) $val
	}
    }
}

proc roster::override_category_and_subtype {connid jid category subtype} {
    variable roster

    set roster(overridden_category_and_subtype,$connid,$jid) \
	[list $category $subtype]
}

proc roster::override_category {connid jid category} {
    variable roster

    set roster(overridden_category_and_subtype,$connid,$jid) \
	[list $category \
	    [lindex $roster(overridden_category_and_subtype,$connid,$jid) 1]]
}

proc roster::override_subtype {connid jid subtype} {
    variable roster

    set roster(overridden_category_and_subtype,$connid,$jid) \
	[list \
	    [lindex $roster(overridden_category_and_subtype,$connid,$jid) 0] \
	    $subtype]
}

proc roster::get_category_and_subtype {connid jid} {
    variable roster

    if {[info exists roster(overridden_category_and_subtype,$connid,$jid)]} {
	return $roster(overridden_category_and_subtype,$connid,$jid)
    }

    variable roster

    array unset roster jids,*
    array unset roster group,*
    array unset roster name,*
    array unset roster subsc,*
    array unset roster ask,*

    array unset roster subtype,*
    array unset roster cached_category_and_subtype,*
    array unset roster overridden_category_and_subtype,*
    ::redraw_roster
}

proc roster::clean_connection {connid} {
    variable roster

    array unset roster jids,$connid
    array unset roster group,$connid,*
    array unset roster name,$connid,*
    array unset roster subsc,$connid,*
    array unset roster ask,$connid,*

    array unset roster subtype,$connid,*
    array unset roster cached_category_and_subtype,$connid,*
    array unset roster overridden_category_and_subtype,$connid,*

    ::redraw_roster
}