# $Id: georoster.tcl 1760 2009-03-29 10:51:55Z sergei $

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

package require msgcat

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

option add *GeoRoster.cityforeground green3 widgetDefault

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

namespace eval georoster {
    ::msgcat::mcload [file join [file dirname [info script]] msgs]

    if {![::plugins::is_registered georoster]} {
	::plugins::register georoster \
			    -namespace [namespace current] \
			    -source [info script] \
			    -description [::msgcat::mc "Whether the Georoster plugin is loaded."] \
			    -loadcommand [namespace code load] \
			    -unloadcommand [namespace code unload]
	return
    }

    variable georoster
    variable options

    if {![info exists options(citiesfile)]} {
	set options(citiesfile) [file join [file dirname [info script]] earth]
	foreach pr [::msgcat::mcpreferences] {
	    set f [file join [file dirname [info script]] "earth.$pr"]
	    if {[file exists $f]} {
		set options(citiesfile) $f
		break
	    }
	}
	unset pr f
    }

    if {![info exists options(3166file)]} {
	set options(3166file) [file join [file dirname [info script]] iso3166]
    }
    if {![info exists georoster(3166)]} {
	set georoster(3166) {}
    }

    foreach file [glob -nocomplain \
		       [file join [file dirname [info script]] ??.coords]] {
	set c [file tail [file rootname $file]]
	if {![info exists options(coords,$c)]} {
	    set options(coords,$c) $file
	}
    }

    if {![info exists options(mapfile)]} {
	set options(mapfile) \
	    [file join [file dirname [info script]] bwmap2.gif]

	proc lo {x y} {expr {($x - 649)*18/65 + 10}}
	proc la {x y} {expr {(371 - $y)*9/40}}

	proc x {lo la} {expr {649+(($lo-10)*65/18)}}
	proc y {lo la} {expr {371-($la * 40/9)}}
    }

    custom::defgroup Plugins [::msgcat::mc "Plugins options."] \
	-group Tkabber

    custom::defgroup Georoster [::msgcat::mc "Georoster plugin options."] \
	-group Plugins

    custom::defvar options(automatic) 0 \
	[::msgcat::mc "Automatically open Georoster window."] \
	-group Georoster -type boolean

    custom::defvar options(check_vcard) 0 \
	[::msgcat::mc "Automatically look at vCard to find users coordinates."] \
	-group Georoster -type boolean

    custom::defvar options(show_last_known) 0 \
	[::msgcat::mc "Display users who are no longer available."] \
	-group Georoster -type boolean

    custom::defvar options(default_country) us \
	[::msgcat::mc "Default country to use when looking at a vCard."] \
	-group Georoster -type string

    set opt2label_list [list none    [::msgcat::mc "Don't show cities"] \
			     markers [::msgcat::mc "Show only city markers"] \
			     all     [::msgcat::mc "Show city markers and names"]]

    array set opt2label $opt2label_list

    array set label2opt [list [::msgcat::mc "Don't show cities"]           none \
			      [::msgcat::mc "Show only city markers"]      markers \
			      [::msgcat::mc "Show city markers and names"] all]

    custom::defvar options(showcities) all \
	[::msgcat::mc "Specify how to show cities at the map."] \
	-group Georoster -type options \
	-values $opt2label_list -command [namespace current]::set_showcities

    variable showcities $opt2label($options(showcities))
}

package require http 2
package require xmpp::private

proc georoster::load {} {
    hook::add finload_hook [namespace current]::setup
    hook::add client_presence_hook [namespace current]::presence_change
    hook::add connected_hook [namespace current]::init 1
    hook::add connected_hook [namespace current]::retrieve
    hook::add save_session_hook [namespace current]::save_session

    trace variable [namespace current]::showcities w \
		   [namespace current]::set_option_showcities
    setup

    foreach xlib [connections] {
	init $xlib
	retrieve $xlib
    }
}

proc georoster::unload {} {
    hook::remove finload_hook [namespace current]::setup
    hook::remove client_presence_hook [namespace current]::presence_change
    hook::remove connected_hook [namespace current]::init 1
    hook::remove connected_hook [namespace current]::retrieve
    hook::remove save_session_hook [namespace current]::save_session

    trace vdelete [namespace current]::showcities w \
		  [namespace current]::set_option_showcities
    catch {
	set m [.mainframe getmenu roster]
	set idx [$m index [::msgcat::mc "Georoster"]]
	$m delete $idx
    }

    destroy_win .georoster

    variable mapimage
    variable georoster
    variable status
    variable geo3166
    variable move
    variable cities
    variable options

    image delete $mapimage

    catch {unset options(mapfile)}
    catch {unset mapimage}
    catch {unset georoster}
    catch {unset status}
    catch {unset geo3166}
    catch {unset move}
    catch {unset cities}
}

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

proc georoster::set_showcities {args} {
    variable options
    variable showcities
    variable opt2label

    set showcities $opt2label($options(showcities))

    redraw .georoster.c
}

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

proc georoster::set_option_showcities {args} {
    variable options
    variable showcities
    variable label2opt

    set options(showcities) $label2opt($showcities)
}

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

proc georoster::setup {} {
    variable mapimage
    variable options

    set mapimage [image create photo -file $options(mapfile)]

    load_cities
    load_3166

    set m [.mainframe getmenu roster]

    $m add command \
	-label [::msgcat::mc "Georoster"] \
	-command [list [namespace current]::open_georoster -raise 1]
}

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

proc georoster::open_georoster {args} {
    variable options
    variable mapimage

    set raise 0
    foreach {key val} $args {
	switch -- $key {
	    -raise { set raise $val }
	}
    }

    set w .georoster
    if {[winfo exists $w]} {
	if {$raise} {
	    raise_win $w
	}
	return
    }

    set title [::msgcat::mc "Georoster"]
    add_win $w -title $title \
	       -tabtitle $title \
	       -class GeoRoster \
	       -raise $raise

    set sw [ScrolledWindow $w.sw]
    pack $sw -side top -fill both -expand yes
    set c [canvas $w.c]
    $sw setwidget $c

    DropSite::register $c -droptypes {JID {}} \
	-dropcmd [list [namespace current]::drop_jid $c]

    set tb [frame $w.tb]
    pack $tb -side bottom -fill x

    set status [label $tb.status -textvariable [namespace current]::status]
    pack $status -side left -anchor w

    set store [button $tb.store -text [::msgcat::mc "Store"] \
		   -command [namespace current]::store]
    pack $store -side right

    set cities [OptionMenu $tb.cities \
		    [namespace current]::showcities \
		    [::msgcat::mc "Don't show cities"] \
		    [::msgcat::mc "Show only city markers"] \
		    [::msgcat::mc "Show city markers and names"]]
    pack $tb.cities -side right


    $c create image 0 0 -image $mapimage -anchor nw -tags map
    $w.c configure -scrollregion [$w.c bbox all]

    bind $c <Motion> [list [namespace current]::on_mouse_move $c %x %y]
    bind $c <Leave> [list set [namespace current]::status ""]

    bind $c <ButtonPress-1> \
	[list [namespace current]::move_b1p \
	     [double% $c] %x %y]
    bind $c <B1-Motion> [list [namespace current]::move_b1m \
			     [double% $c] %x %y]
    bind $c <ButtonRelease-1> \
	[list [namespace current]::move_b1r [double% $c]]

    bind $c <ButtonPress-2> \
	[list [namespace current]::delete [double% $c] %x %y]
    bind $c <Control-ButtonPress-1> \
	[list [namespace current]::delete [double% $c] %x %y]

    redraw $c
}

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

proc georoster::on_mouse_move {c x y} {
    variable georoster
    variable status

    set x [$c canvasx $x]
    set y [$c canvasy $y]

    set lo [lo $x $y]
    set la [la $x $y]

    set georoster(cur_lo) $lo
    set georoster(cur_la) $la

    set status [::msgcat::mc "Latitude: %.2f  Longitude: %.2f" $la $lo]
}

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

proc georoster::drop_jid {c target source x y op type data} {
    variable georoster

    lassign $data xlib jid

    set x [$c canvasx [expr {$x - [winfo rootx $c]}]]
    set y [$c canvasy [expr {$y - [winfo rooty $c]}]]

    set lo [lo $x $y]
    set la [la $x $y]

    update_jid $c $xlib $jid $la $lo
}

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

proc georoster::redraw {c} {
    variable georoster

    if {![winfo exists $c]} return

    $c delete icon

    redraw_cities $c

    foreach nxlib [array names georoster jids,*] {
	set xlib [string range $nxlib 5 end]

	foreach jid $georoster(jids,$xlib) {
	    set lo $georoster(lo,$xlib,$jid)
	    set la $georoster(la,$xlib,$jid)
	    set x [x $lo $la]
	    set y [y $lo $la]

	    set icon roster/user/unavailable
	    catch {set icon [ifacetk::roster::get_jid_icon $xlib $jid]}

	    set tag [jid_to_tag $jid]

	    $c create image $x $y -image $icon \
		-tags [list icon xlib$xlib jid$tag] -anchor c

	    set doubledjid [double% $jid]
	    set jids [ifacetk::roster::get_jids_of_user $xlib $jid]

	    if {[llength $jids] > 0} {
		set doubledjids [double% $jids]
	    } else {
		set jids [list $jid]
		# TODO: Turn into metacontacts
		#if {$ifacetk::roster::use_aliases && \
		#        [info exists roster::aliases($jid)]} {
		#    set jids [concat $jids $roster::aliases($jid)]
		#}
		set doubledjids [double% $jids]
	    }

	    #$c bind jid$tag <Any-Enter> \
	    #    +[list eval balloon::set_text \
	    #         \[roster::jids_popup_info [list $doubledjids]\]]
	    #
	    #$c bind jid$tag <Any-Motion> \
	    #    [list eval balloon::on_mouse_move \
	    #        \[roster::jids_popup_info [list $doubledjids]\] %X %Y]

	    $c bind jid$tag <Any-Enter> \
		+[list [namespace current]::set_balloon_text \
		      balloon::set_text \
		      $xlib $doubledjid %X %Y]

	    $c bind jid$tag <Any-Motion> \
		[list [namespace current]::set_balloon_text \
		     balloon::on_mouse_move \
		     $xlib $doubledjid %X %Y]

	    $c bind jid$tag <Any-Leave> {+
		balloon::destroy
	    }
	}
    }
}

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

proc georoster::set_balloon_text {op xlib jid sx sy} {
    set c .georoster.c
    set x [$c canvasx [expr {$sx - [winfo rootx $c]}]]
    set y [$c canvasy [expr {$sy - [winfo rooty $c]}]]

    set ids [$c find overlapping \
		 [expr {$x-2}] [expr {$y-2}] \
		 [expr {$x+2}] [expr {$y+2}]]

    set city_prefix ""

    foreach id $ids {
	set tags [$c gettags $id]
	if {[lcontain $tags city] && [lcontain $tags oval]} {
	    set name [crange [lmatch -glob $tags name*] 4 end]
	    append city_prefix "$name\n"
	}
    }

    set all_jids {}

    foreach id $ids {
	set tags [$c gettags $id]

	if {![lcontain $tags icon]} continue

	set xlib [crange [lmatch -glob $tags xlib*] 4 end]

	set jidtag [crange [lmatch -glob $tags jid*] 3 end]
	set jid [tag_to_jid $jidtag]

	set jids {}
	foreach j [ifacetk::roster::get_jids_of_user $xlib $jid] {
	    lappend jids [list $xlib $j]
	}

	if {[llength $jids] == 0} {
	    if {[catch { list [list $xlib $jid] } jids]} {
		set jids {}
	    }
	    # TODO: Turn into metacontacts
	    #if {$ifacetk::roster::use_aliases && [info exists roster::aliases($jid)]} {
	    #	foreach j $roster::aliases($jid) {
	    #	    lappend jids [list $xlib $j]
	    #	}
	    #}
	}
	set all_jids [concat $all_jids $jids]
    }

    set all_jids [lrmdups $all_jids]

    set text ""
    set i 0
    foreach cj $all_jids {
	lassign $cj xlib j
	append text "\n"
	append text [::msgcat::mc "Connection: %s" [connection_jid $xlib]]
	append text "\n"
	append text [ifacetk::roster::user_popup_info $xlib $j $i]
	incr i
    }
    set text [string trimleft $text "\n"]

    if {$op == "balloon::set_text"} {
	$op "${city_prefix}$text"
    } else {
	$op "${city_prefix}$text" $sx $sy
    }
}

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

proc georoster::presence_change {xlib from type x args} {
    variable options
    variable georoster

    if {![info exists georoster(jids,$xlib)]} {
	set georoster(jids,$xlib) {}
    }

    set jid [::xmpp::jid::stripResource $from]
    switch -- $type {
	error -
	subscribe -
	subscribed -
	unsubscribe -
	unsubscribed -
	probe {
	    return
	}

	unavailable {
	    if {!$options(show_last_known)} {
		if {[set x [lsearch -exact $georoster(jids,$xlib) $jid]] >= 0} {
		    set georoster(jids,$xlib) [lreplace $georoster(jids,$xlib) $x $x]
		}
		return
	    }

	    set to $jid
	}

	available -
	default {
	    set to $from
	}
    }

    if {($options(check_vcard)) \
	    && ([lsearch -exact $georoster(jids,$xlib) $jid] < 0) \
	    && ([string compare conference \
			[lindex [roster::get_category_and_subtype $xlib \
					 $jid] 0]])} {
	::xmpp::sendIQ $xlib get \
	    -query [::xmpp::xml::create vCard -xmlns vcard-temp] \
	    -to $to \
	    -command [list [namespace current]::parse_vcard .georoster.c $xlib $jid]
    }

    if {$options(automatic)} {
	open_georoster -raise 0
    }
    redraw .georoster.c
}

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

proc georoster::parse_vcard {w xlib jid status xml} {
    variable geo3166
    variable georoster
    variable options

    if {![cequal $status ok]} {
	return
    }

    ::xmpp::xml::split $xml tag xmlns attrs cdata subels

    array set info [list CTRY "" COUNTRY ""]
    foreach item $subels {
	::xmpp::xml::split $item tag xmlns attrs cdata subels

	switch -- $tag {
	    ADR {
		foreach item $subels {
		    ::xmpp::xml::split $item tag xmlns attrs cdata subels
		    array set info [list $tag [string trim $cdata]]
		}
	    }

	    EMAIL {
		set georoster(email,$xlib,$jid) [string trim $cdata]
	    }

	    GEO {
		foreach item $subels {
		    ::xmpp::xml::split $item tag xmlns attrs cdata subels
		    array set info [list $tag [string trim $cdata]]
		}
		if {([info exists info(LAT)]) \
			&& ([string is double -strict $info(LAT)]) \
			&& ([info exists info(LON)]) \
			&& ([string is double -strict $info(LON)])} {
		    update_jid $w $xlib $jid $info(LAT) $info(LON)
		    return
		}
	    }
	}
    }

    if {(![cequal $info(CTRY) ""]) && ([cequal $info(COUNTRY) ""])} {
	set info(COUNTRY) $info(CTRY)
    }
    unset info(CTRY)
    if {[cequal $info(COUNTRY) ""]} {
	set args [list $jid]
	if {[info exists georoster(email,$xlib,$jid)]} {
	    lappend args $georoster(email,$xlib,$jid)
	}
	foreach addr $args {
	    if {([set x [string last . $addr]] > 0) \
		    && ([lsearch -exact $georoster(3166) \
				 [set c [string range $addr [expr $x+1] \
						end]]] >= 0)} {
		set info(COUNTRY) $c
		break
	    }
	}

	if {[cequal $info(COUNTRY) ""]} {
	    set info(COUNTRY) $options(default_country)
	}
    }
    set info(COUNTRY) [set c [string tolower $info(COUNTRY)]]
    if {[info exists geo3166($c)]} {
	set info(COUNTRY) $geo3166($c)
    }
    foreach {k v} [array get info] {
	if {[cequal $v ""]} {
	    unset info($k)
	}
    }

    switch -- $info(COUNTRY) {
	us {
	    set args {}
	    foreach {k v} [list PCODE zip REGION state LOCALITY city] {
		if {([info exists info($k)]) && (![cequal $info($k) ""])} {
		    lappend args $v $info($k)
		}
	    }
	    if {[llength $args] > 0} {
		set query [eval ::http::formatQuery $args]

		if {![catch {
		    ::http::geturl \
			http://www.census.gov/cgi-bin/gazetteer?$query \
			-timeout 300 \
			-command [list [namespace current]::parse_vcard_aux $w \
				       $xlib $jid [array get info]]
		      }]} {
		    debugmsg georoster "async http: $xlib $jid"
		    return
		}
	    }
	}

	default {
	}
    }

    parse_vcard_aux2 $w $xlib $jid [array get info]
}

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

proc georoster::parse_vcard_aux {w xlib jid xinfo httpT} {
    debugmsg georoster "  aux http: $xlib $jid"

    set data ""
    if {![cequal [set status [::http::status $httpT]] ok]} {
	debugmsg georoster " gazetteer: $status"
    } elseif {![string match 2* [::http::ncode $httpT]]} {
	debugmsg georoster " gazetteer: [::http::code $httpT]"
    } else {
	set data [::http::data $httpT]
    }

    catch { ::http::cleanup $httpT }

    if {([set x [string first "lat=" $data]] > 0) \
	    && ([set x \
		     [string first "&wid" \
			     [set data [string range $data \
					       [expr $x+4] \
					       end]]]] > 0) \
	    && ([set x \
		     [string first "&lon=" \
			     [set data \
				  [string range $data 0 \
					  [expr $x-1]]]]] > 0) \
	    && ([string is double -strict \
			[set la [string range $data 0 [expr $x-1]]]]) \
	    && ([string is double -strict \
			[set lo [string range $data [expr $x+5] end]]])} {
	debugmsg georoster " gazetteer: $xlib $jid $la $lo"

	update_jid $w $xlib $jid $la $lo
	return
    }

    parse_vcard_aux2 $w $xlib $jid $xinfo
}

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

proc georoster::parse_vcard_aux2 {w xlib jid xinfo} {
    variable options

    debugmsg georoster "     vcard: $xlib $jid $xinfo"

    array set info $xinfo

    if {([info exists info(LOCALITY)]) \
	    && ([info exists options(coords,$info(COUNTRY))]) \
	    && (![catch { open $options(coords,$info(COUNTRY)) \
			       { RDONLY } } fd])} {
	if {[catch { string tolower $info(REGION) } region]} {
	    set region ""
	}
	set locality [string tolower $info(LOCALITY)]

	fconfigure $fd -encoding utf-8

	while {[gets $fd line] >= 0} {
	    if {[set x [string first "#" $line]] >= 0} {
		set line [string range $line 0 [expr $x-1]]
	    }
	    if {[catch { split $line "\t" } elems]} {
		continue
	    }

	    switch -- [llength $elems] {
		0 - 3 {
		    continue
		}

		2 {
		    if {[cequal $region [lindex $elems 1]]} {
			set region [lindex $elems 0]
			debugmsg georoster \
				 "     vcard: normalize region to $region"
		    }
		    continue
		}

		4 - default {
		    if {([cequal $region [lindex $elems 0]]) \
			    && ([cequal $locality [lindex $elems 1]])} {
			if {([string is double -strict \
				     [set la [lindex $elems 2]]]) \
				&& ([string is double -strict \
					    [set lo [lindex $elems 3]]])} {
			    close $fd

			    debugmsg georoster "    coords: $xlib $jid $la $lo"
			    update_jid $w $xlib $jid $la $lo
			    return
			}

			debugmsg georoster "     vcard: invalid line: $line"
			break
		    }
		}
	    }
	}

	close $fd
    }

    hook::run georoster:locate_hook $xlib $jid \
	[list [namespace current]::update_jid $w $xlib $jid]
}

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

proc georoster::update_jid {w xlib jid latitude longitude} {
    variable georoster

    if {![lcontain $georoster(jids,$xlib) $jid]} {
	lappend georoster(jids,$xlib) $jid
    }

    set georoster(la,$xlib,$jid) $latitude
    set georoster(lo,$xlib,$jid) $longitude
    redraw $w
}

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

proc georoster::move_b1p {c x y} {
    variable move

    set tags [$c gettags current]
    #puts $tags
    if {[lcontain $tags icon]} {
	set x [$c canvasx $x]
	set y [$c canvasy $y]

	set move(startx) $x
	set move(starty) $y
	set move(lastx) $x
	set move(lasty) $y

	set xlib [crange [lmatch -glob $tags xlib*] 4 end]
	set move(xlib) $xlib

	set jidtag [crange [lmatch -glob $tags jid*] 3 end]
	set jid [tag_to_jid $jidtag]
	set move(jid) $jid
    } else {
	catch {unset move(jid)}
    }
}

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

proc georoster::move_b1m {c x y} {
    variable move
    variable georoster
    variable status

    if {[info exists move(jid)]} {
	set ctag xlib$move(xlib)
	set tag jid[jid_to_tag $move(jid)]
	set x [$c canvasx $x]
	set y [$c canvasy $y]

	set xlib $move(xlib)
	set jid $move(jid)
	set lo $georoster(lo,$xlib,$jid)
	set la $georoster(la,$xlib,$jid)
	set oldx [x $lo $la]
	set oldy [y $lo $la]

	set newx [expr {$oldx + $x - $move(startx)}]
	set newy [expr {$oldy + $y - $move(starty)}]

	set newlo [lo $newx $newy]
	set newla [la $newx $newy]

	set status [::msgcat::mc "Latitude: %.2f  Longitude: %.2f" $newla $newlo]

	$c move icon&&$ctag&&$tag [expr {$x - $move(lastx)}] [expr {$y - $move(lasty)}]

	set move(lastx) $x
	set move(lasty) $y
    }
}

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

proc georoster::move_b1r {c} {
    variable move
    variable georoster

    if {[info exists move(jid)]} {
	set ctag xlib$move(xlib)
	set tag jid[jid_to_tag $move(jid)]

	set xlib $move(xlib)
	set jid $move(jid)
	set x $move(lastx)
	set y $move(lasty)

	set lo $georoster(lo,$xlib,$jid)
	set la $georoster(la,$xlib,$jid)
	set oldx [x $lo $la]
	set oldy [y $lo $la]

	set newx [expr {$oldx + $x - $move(startx)}]
	set newy [expr {$oldy + $y - $move(starty)}]

	set newlo [lo $newx $newy]
	set newla [la $newx $newy]

	update_jid $c $xlib $jid $newla $newlo
    }
}

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

proc georoster::delete {c x y} {
    variable georoster

    set tags [$c gettags current]
    #puts $tags
    if {[lcontain $tags icon]} {
	set x [$c canvasx $x]
	set y [$c canvasy $y]

	set xlib [crange [lmatch -glob $tags xlib*] 4 end]

	set jidtag [crange [lmatch -glob $tags jid*] 3 end]
	set jid [tag_to_jid $jidtag]

	set idx [lsearch -exact $georoster(jids,$xlib) $jid]
	set georoster(jids,$xlib) [lreplace $georoster(jids,$xlib) $idx $idx]

	redraw $c
    }
}

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

proc georoster::store {} {
    variable georoster

    foreach nxlib [array names georoster jids,*] {
	set xlib [string range $nxlib 5 end]

	set items($xlib) {}

	foreach jid $georoster(jids,$xlib) {
	    set lo $georoster(lo,$xlib,$jid)
	    set la $georoster(la,$xlib,$jid)

	    lappend items($xlib) [::xmpp::xml::create item \
					-attrs [list jid $jid lo $lo la $la]]
	}
    }

    foreach xlib [array names items] {
	::xmpp::private::store $xlib [list [::xmpp::xml::create query \
						-xmlns tkabber:georoster \
						-subelements $items($xlib)]]
    }
}

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

proc georoster::init {xlib} {
    variable georoster

    if {![info exists georoster(jids,$xlib)]} {
	set georoster(jids,$xlib) {}
    }
}

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

proc georoster::retrieve {xlib} {
    ::xmpp::private::retrieve $xlib [list [::xmpp::xml::create query \
						-xmlns tkabber:georoster]] \
	    -command [list [namespace current]::recv $xlib]
}

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

proc georoster::recv {xlib status xmllist} {
    variable georoster

    if {$status != "ok"} {
	return
    }

    set georoster(jids,$xlib) {}

    foreach element $xmllist {
	::xmpp::xml::split $element tag xmlns attrs cdata subels

	foreach item $subels {
	    ::xmpp::xml::split $item stag sxmlns sattrs scdata ssubels
	    set jid [::xmpp::xml::getAttr $sattrs jid]
	    if {$jid != ""} {
		lappend georoster(jids,$xlib) $jid
		set georoster(lo,$xlib,$jid) [::xmpp::xml::getAttr $sattrs lo]
		set georoster(la,$xlib,$jid) [::xmpp::xml::getAttr $sattrs la]
	    }
	}
    }
    after idle [list [namespace current]::redraw .georoster.c]
}

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

proc georoster::compare_lo {namex namey} {
    variable cities

    set x $cities(lo,$namex)
    set y $cities(lo,$namey)

    if {$x < $y} { return 1 }
    if {$x > $y} { return -1 }
    return 0
}

proc georoster::load_cities {} {
    variable options
    variable cities

    set cities(list) {}

    set fd [open $options(citiesfile) r]
    fconfigure $fd -encoding utf-8

    while {![eof $fd]} {
	set s [gets $fd]

	if {[cindex $s 0] == "#"} continue

	set la [lindex $s 0]
	set lo [lindex $s 1]
	set name [lindex $s 2]

	if {![string is double -strict $lo]} continue
	if {![string is double -strict $la]} continue

	lappend cities(list) $name
	set cities(lo,$name) $lo
	set cities(la,$name) $la
    }

    close $fd

    set cities(list) \
	[lsort -command [namespace current]::compare_lo $cities(list)]
}

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

proc georoster::redraw_cities {c} {
    variable georoster
    variable cities
    variable options

    set moves [list -3 6 -9 12 -15 18 -21 24 -12]

    if {![winfo exists $c]} return

    $c delete city

    if {$options(showcities) == "none"} return

    foreach name $cities(list) {
	set lo $cities(lo,$name)
	set la $cities(la,$name)
	#puts "$name: LO: $lo  LA: $la"
	set x [x $lo $la]
	set y [y $lo $la]

	#set tag [jid_to_tag $name]

	set id [$c create oval \
		    [expr {$x-2}] [expr {$y-2}] \
		    [expr {$x+2}] [expr {$y+2}] \
		    -tags [list city oval name$name] \
		    -outline red]

	$c bind $id <Any-Enter> \
	    +[list balloon::set_text $name]

	$c bind $id <Any-Motion> \
	    [list balloon::on_mouse_move $name %X %Y]

	$c bind $id <Any-Leave> {+
	    balloon::destroy
	}

	if {$options(showcities) == "all"} {
	    set txt [$c create text [expr {$x+4}] $y -text $name -anchor w \
			 -fill [option get [winfo parent $c] cityforeground GeoRoster] \
			 -tags [list city text name$name]]
	    lassign [$c bbox $txt] x1 y1 x2 y2
	    set overlap [$c find overlapping $x1 $y1 $x2 $y2]
	    foreach ym $moves {
		if {[llength $overlap] > 2} {
		    $c move $txt 0 $ym
		    lassign [$c bbox $txt] x1 y1 x2 y2
		    set overlap [$c find overlapping $x1 $y1 $x2 $y2]
		} else {
		    break
		}
	    }
	}
    }
    $c lower city icon
    $c lower text oval
}

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

proc georoster::load_3166 {} {
    variable options
    variable geo3166
    variable georoster

    if {[catch { open $options(3166file) { RDONLY } } fd]} {
	return
    }

    while {[gets $fd line] >= 0} {
	if {[set x [string first "#" $line]] >= 0} {
	    set line [string range $line 0 [expr $x-1]]
	}
	if {[catch { split $line "\t" } elems]} {
	    continue
	}

	switch -- [llength $elems] {
	    0 - 1 {
		continue
	    }

	    2 - default {
		set geo3166([lindex $elems 1]) [set c [lindex $elems 0]]
		if {[lsearch -exact $georoster(3166) $c] < 0} {
		    lappend georoster(3166) $c
		}
	    }
	}
    }

    close $fd
}

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

proc georoster::restore_window {args} {
    open_georoster -raise 1
}

proc georoster::save_session {vsession} {
    upvar 2 $vsession session
    global usetabbar

    # We don't need JID at all, so make it empty (special case)
    set user     ""
    set server   ""
    set resource ""

    # TODO
    if {!$usetabbar} return

    set prio 0
    foreach page [.nb pages] {
	set path [ifacetk::nbpath $page]

	if {[string equal $path .georoster]} {
	    lappend session [list $prio $user $server $resource \
		[list [namespace current]::restore_window] \
	    ]
	}
	incr prio
    }
}

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

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