# georoster.tcl --
#
#       This file implements Georoster plugin for the Tkabber XMPP client.

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]] \
                                           cities earth]
        foreach pr [::msgcat::mcpreferences] {
            set f [file join [file dirname [info script]] cities "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 ??.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]] maps 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

    set c [Wrapped $c]

    bindscroll $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

    $w.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 [double% $w.c] \
                                                              %x %y]
    bind $c <Leave> [list set [namespace current]::status ""]

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

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

    redraw $w.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 {[lsearch -exact $tags city] >= 0 && \
                [lsearch -exact $tags oval] >= 0} {
            set name [string range [lsearch -inline -glob $tags name*] 4 end]
            append city_prefix "$name\n"
        }
    }

    set all_jids {}

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

        if {[lsearch -exact $tags icon] < 0} continue

        set xlib [string range [lsearch -inline -glob $tags xlib*] 4 end]

        set jidtag [string range [lsearch -inline -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 [lsort -unique $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)} {
                set x [lsearch -exact $georoster(jids,$xlib) $jid]
                if {$x >= 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 {$status ne "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 {($info(CTRY) ne "") && ($info(COUNTRY) eq "")} {
        set info(COUNTRY) $info(CTRY)
    }
    unset info(CTRY)
    if {$info(COUNTRY) eq ""} {
        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 {$info(COUNTRY) eq ""} {
            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 {$v eq ""} {
            unset info($k)
        }
    }

    switch -- $info(COUNTRY) {
        us {
            set args {}
            foreach {k v} [list PCODE zip REGION state LOCALITY city] {
                if {([info exists info($k)]) && ($info($k) ne "")} {
                    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 {[set status [::http::status $httpT]] ne "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 {$region eq [lindex $elems 1]} {
                        set region [lindex $elems 0]
                        debugmsg georoster \
                                 "     vcard: normalize region to $region"
                    }
                    continue
                }

                4 - default {
                    if {($region eq [lindex $elems 0]) \
                            && ($locality eq [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 {[lsearch -exact $georoster(jids,$xlib) $jid] < 0} {
        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 {[lsearch -exact $tags icon] >= 0} {
        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 [string range [lsearch -inline -glob $tags xlib*] 4 end]
        set move(xlib) $xlib

        set jidtag [string range [lsearch -inline -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 {[lsearch -exact $tags icon] >= 0} {
        set x [$c canvasx $x]
        set y [$c canvasy $y]

        set xlib [string range [lsearch -inline -glob $tags xlib*] 4 end]

        set jidtag [string range [lsearch -inline -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 {[string index $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
                }
            }
        }
    }
    catch {$c lower city icon}
    catch {$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:et
