File: Geolocation.tcl

package info (click to toggle)
coccinella 0.96.20-9
  • links: PTS, VCS
  • area: main
  • in suites: buster, sid
  • size: 13,184 kB
  • sloc: tcl: 124,744; xml: 206; makefile: 66; sh: 62
file content (422 lines) | stat: -rw-r--r-- 13,575 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
# Geolocation.tcl --
# 
#       User location using XEP recommendations over PubSub library code.
#       XEP-0080: User Location (formerly User Geolocation)
#
#  Copyright (c) 2007-2008 Mats Bengtsson
#  
#   This program is free software: you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation, either version 3 of the License, or
#   (at your option) any later version.
#   
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#   
#   You should have received a copy of the GNU General Public License
#   along with this program.  If not, see <http://www.gnu.org/licenses/>.
#  
#  $Id: Geolocation.tcl,v 1.17 2008-06-11 08:12:05 matben Exp $

package require jlib::pep

namespace eval ::Geolocation {

    component::define Geolocation \
      "Communicate information about the current geographical location"
}

proc ::Geolocation::Init {} {

    component::register Geolocation

    # Add event hooks.
    ::hooks::register jabberInitHook        ::Geolocation::JabberInitHook
    ::hooks::register loginHook             ::Geolocation::LoginHook
    ::hooks::register logoutHook            ::Geolocation::LogoutHook
    ::hooks::register buildUserInfoDlgHook  ::Geolocation::UserInfoHook

    variable xmlns
    set xmlns(geoloc)        "http://jabber.org/protocol/geoloc"
    set xmlns(geoloc+notify) "http://jabber.org/protocol/geoloc+notify"
    set xmlns(node_config)   "http://jabber.org/protocol/pubsub#node_config"

    variable menuDef
    # TRANSLATORS: geographical location of the user ( http://xmpp.org/extensions/xep-0080.html#format ); see Action menu when logged in to a server with PEP support
    set menuDef [list command mLocation... {[mc "Locat&ion"]...} ::Geolocation::Dlg {} {}]
    
    # These help strings are for the message catalogs.
    variable help
    set	help(alt)         [mc "Altitude in meters above or below sea level"]
    set	help(area)        [mc "A named area such as a campus or neighborhood"]
    set	help(bearing)     [mc "GPS bearing (direction in which the entity is heading to reach its next waypoint), measured in decimal degrees relative to true north"]
    set	help(building)    [mc "A specific building on a street or in an area"]
    set	help(country)     [mc "The nation where the user is located"]
    set	help(datum)       [mc "GPS datum"]
    set	help(description) [mc "A natural-language name for or description of the location"]
    set	help(error)       [mc "Horizontal GPS error in arc minutes"]
    set	help(floor)       [mc "A particular floor in a building"]
    set	help(lat)         [mc "Latitude in decimal degrees North"]
    set	help(locality)    [mc "A locality within the administrative region, such as a town or city"]
    set	help(lon)         [mc "Longitude in decimal degrees East"]
    set	help(postalcode)  [mc "A code used for postal delivery"]
    set	help(region)      [mc "An administrative region of the nation, such as a state or province"]
    set	help(room)        [mc "A particular room in a building"]
    set	help(street)      [mc "A thoroughfare within the locality, or a crossing of two thoroughfares"]
    set	help(text)        [mc "A catch-all element that captures any other information about the location"]
    set	help(timestamp)   [mc "UTC timestamp specifying the moment when the reading was taken"]
    
    variable taglabel
    set	taglabel(alt)         [mc "Altitude"]
    set	taglabel(area)        [mc "Named Area"]
    set	taglabel(bearing)     [mc "GPS Bearing"]
    set	taglabel(building)    [mc "Building"]
    set	taglabel(country)     [mc "Country"]
    set	taglabel(datum)       [mc "GPS Datum"]
    set	taglabel(description) [mc "Description"]
    set	taglabel(error)       [mc "GPS Error"]
    set	taglabel(floor)       [mc "Floor"]
    set	taglabel(lat)         [mc "Latitude"]
    set	taglabel(locality)    [mc "Locality"]
    set	taglabel(lon)         [mc "Longitude"]
    set	taglabel(postalcode)  [mc "Postal code"]
    set	taglabel(region)      [mc "Region"]
    set	taglabel(room)        [mc "Room"]
    set	taglabel(street)      [mc "Street"]
    set	taglabel(text)        [mc "Text"]
    set	taglabel(timestamp)   [mc "Timestamp"]
    
    # string is the default if not defined.
    variable xs
    array set xs {
	alt         decimal
	bearing     decimal
	error       decimal
	lat         decimal
	lon         decimal
	timestamp   datetime
    }
    
    # This is our cache for other users geoloc.
    variable geoloc
    
    ui::dialog button remove -text [mc "Remove"]
}

# Geolocation::JabberInitHook --
# 
#       Here we announce that we have Geolocation support and is interested in
#       getting notifications.

proc ::Geolocation::JabberInitHook {jlibname} {
    variable xmlns
    
    set E [list]
    lappend E [wrapper::createtag "identity"  \
      -attrlist [list category hierarchy type leaf name "Geolocation"]]
    lappend E [wrapper::createtag "feature" \
      -attrlist [list var $xmlns(geoloc)]]    
    lappend E [wrapper::createtag "feature" \
      -attrlist [list var $xmlns(geoloc+notify)]]
    
    $jlibname caps register geoloc $E [list $xmlns(geoloc) $xmlns(geoloc+notify)]
}

proc ::Geolocation::LoginHook {} {
    variable xmlns
   
    # Disco server for pubsub/pep support.
    set server [::Jabber::Jlib getserver]
    ::Jabber::Jlib pep have $server [namespace code HavePEP]
    ::Jabber::Jlib pubsub register_event [namespace code Event] \
      -node $xmlns(geoloc)
}

proc ::Geolocation::HavePEP {jlibname have} {
    variable menuDef

    if {$have} {
	::JUI::RegisterMenuEntry action $menuDef
    }
}

proc ::Geolocation::LogoutHook {} {
    variable state
    
    ::JUI::DeRegisterMenuEntry action mLocation...
    unset -nocomplain state
}

proc ::Geolocation::Dlg {} {
    variable xmlns
    variable gearth 0
    variable help
    variable taglabel
    
    set w [ui::dialog -message [mc "Set your location that will be shown to your contacts."] \
      -detail [mc "Enter your location details below. At least you should set latitude and longitude."] -icon worldmap \
      -buttons {ok cancel remove} -modal 1 \
      -geovariable ::prefs(winGeom,geoloc) \
      -title [mc "Location"] -command [namespace code DlgCmd]]
    set fr [$w clientframe]
    
    # State array variable.
    variable $w
    upvar 0 $w state
    set token [namespace current]::$w

    foreach name {
	alt
	country
	lat
	lon
    } {
	set str $taglabel($name)
	ttk::label $fr.l$name -text ${str}:
	ttk::entry $fr.e$name -textvariable $token\($name)
	
	grid  $fr.l$name  $fr.e$name  -sticky e -pady 2
	grid $fr.e$name -sticky ew
	
	set str $help($name)
	::balloonhelp::balloonforwindow $fr.l$name $str
	::balloonhelp::balloonforwindow $fr.e$name $str
    }
    
    ttk::button $fr.www -style Url -text www.mapquest.com \
      -command [namespace code [list LaunchUrl $w]]
    
    grid  x  $fr.www  -sticky w

    ttk::checkbutton $fr.gearth -style Small.TCheckbutton \
      -variable [namespace current]::gearth \
      -text [mc "Synchronize with Google Earth"]
    
    $fr.gearth state {disabled}
    
    grid  $fr.gearth  -  -sticky w
    grid columnconfigure $fr 1 -weight 1
    
    # Have some validation.
    foreach name [list alt lat lon] {
	$fr.e$name configure -validate key \
	  -validatecommand [namespace code [list ValidateF %d %P]]    
    }
    trace add variable $token\(lat) write [namespace code [list Trace $w]]
    trace add variable $token\(lon) write [namespace code [list Trace $w]]

    set state(lat) ""
    set state(lon) ""
    
    # Get our own published geolocation and fill in.
    set myjid2 [::Jabber::Jlib  myjid2]
    set cb [namespace code [list ItemsCB $w]]
    ::Jabber::Jlib pubsub items $myjid2 $xmlns(geoloc) -command $cb
        
    bind $fr.ealt <Map> { focus %W }
    
    set mbar [::JUI::GetMainMenu]
    ui::dialog defaultmenu $mbar
    ::UI::MenubarDisableBut $mbar edit
    $w grab    
    ::UI::MenubarEnableAll $mbar
}

proc ::Geolocation::Trace {w name1 name2 op} {
    variable $w
    upvar 0 $w state
        
    set fr [$w clientframe]
    if {($state(lat) ne "") && ($state(lon) ne "")} {
	$fr.www state {!disabled}
    } else {
	$fr.www state {disabled}    
    }
}

proc ::Geolocation::LaunchUrl {w} {
    variable $w
    upvar 0 $w state

    set lat $state(lat)
    set lon $state(lon)
    set url "http://www.mapquest.com/maps/map.adp?latlongtype=decimal&latitude=${lat}&longitude=${lon}"
    ::Utils::OpenURLInBrowser $url    
}

proc ::Geolocation::ValidateF {insert P} {
    if {$insert} {
	set valid [string is double -strict $P]
	if {!$valid} {
	    bell
	}
	return $valid
    } else {
	return 1
    }
}

proc ::Geolocation::ItemsCB {w type subiq args} {
    variable $w
    upvar 0 $w state
    variable xmlns
    
    if {$type eq "error"} {
	return
    }
    
    # Fill in the form.
    if {[winfo exists $w]} {
	foreach itemsE [wrapper::getchildren $subiq] {
	    set tag [wrapper::gettag $itemsE]
	    set node [wrapper::getattribute $itemsE "node"]
	    if {[string equal $tag "items"] && [string equal $node $xmlns(geoloc)]} {
		set itemE [wrapper::getfirstchildwithtag $itemsE item]
		set geolocE [wrapper::getfirstchildwithtag $itemE geoloc]
		if {![llength $geolocE]} {
		    return
		}
		foreach E [wrapper::getchildren $geolocE] {
		    set tag  [wrapper::gettag $E]
		    set data [wrapper::getcdata $E]
		    if {[string length $data]} {
			set state($tag) $data
		    }
		}
	    }
	}
    }
}

proc ::Geolocation::DlgCmd {w bt} {
    variable $w
    upvar 0 $w state
    variable xmlns
    
    if {$bt eq "ok"} {
	Publish $w
    } elseif {$bt eq "remove"} {
	Retract $w
    }
    unset -nocomplain state
}

proc ::Geolocation::Publish {w} {
    variable $w
    upvar 0 $w state
    variable xmlns
    
    # Create gelocation stanza before publish.
    set childL [list]
    foreach {key value} [array get state] {
	if {[string length $value]} {
	    lappend childL [wrapper::createtag $key -chdata $value]
	}
    }
    set geolocE [wrapper::createtag "geoloc" \
      -attrlist [list xml:lang [jlib::getlang]] -subtags $childL]

    #   NB:  It is currently unclear there should be an id attribute in the item
    #        element since PEP doesn't use it but pubsub do, and the experimental
    #        OpenFire PEP implementation.
    #set itemE [wrapper::createtag item -subtags [list $geolocE]]
    set itemE [wrapper::createtag item \
      -attrlist [list id current] -subtags [list $geolocE]]

    ::Jabber::Jlib pep publish $xmlns(geoloc) $itemE
}

proc ::Geolocation::Retract {w} {
    variable xmlns

    ::Jabber::Jlib pep retract $xmlns(geoloc) -notify 1
}

# Geolocation::Event --
# 
#       Mood event handler for incoming geoloc messages.

proc ::Geolocation::Event {jlibname xmldata} {
    variable geoloc
    
    # The server MUST set the 'from' address on the notification to the 
    # bare JID (<node@domain.tld>) of the account owner.
    set from [wrapper::getattribute $xmldata from]
    set from [jlib::jidmap $from]
    set geoloc($from) $xmldata

    ::hooks::run geolocEvent $xmldata
}

proc ::Geolocation::UserInfoHook {jid wnb} {
    variable xmlns
    variable geoloc
    variable help
    variable taglabel

    set mjid [jlib::jidmap [jlib::barejid $jid]]
    if {![info exists geoloc($mjid)]} {
	return
    }
    if ([winfo exists $wnb.geo]) {
        return
    }
    
    $wnb add [ttk::frame $wnb.geo] -text [mc "Location"] -sticky news

    set wpage $wnb.geo.f
    ttk::frame $wpage -padding [option get . notebookPagePadding {}]
    pack  $wpage  -side top -anchor [option get . dialogAnchor {}]

    ttk::label $wpage._lbl -text [mc "This is location data for %s" $jid]
    grid  $wpage._lbl  -  -pady 2
    
    ttk::button $wpage.mapquest -style Url -text www.mapquest.com
    grid  $wpage.mapquest  -  -pady 2
    $wpage.mapquest state {disabled}
    
    # Extract all geoloc data we have cached and write an entry for each.
    set xmldata $geoloc($mjid)
    set eventE [wrapper::getfirstchildwithtag $xmldata event]
    if {[llength $eventE]} {
	foreach itemsE [wrapper::getchildren $eventE] {
	    set tag [wrapper::gettag $itemsE]
	    set node [wrapper::getattribute $itemsE "node"]
	    if {[string equal $tag "items"] && [string equal $node $xmlns(geoloc)]} {
		set itemE [wrapper::getfirstchildwithtag $itemsE item]
		set geolocE [wrapper::getfirstchildwithtag $itemE geoloc]
		if {![llength $geolocE]} {
		    return
		}
		foreach E [wrapper::getchildren $geolocE] {
		    set tag  [wrapper::gettag $E]
		    set data [wrapper::getcdata $E]
		    set state($tag) $data
		    if {[string length $data]} {
			
			set str $taglabel($tag)
			ttk::label $wpage.l$tag -text ${str}:
			ttk::label $wpage.e$tag -text $data
			
			grid  $wpage.l$tag  $wpage.e$tag  -pady 2
			grid $wpage.l$tag -sticky e
			grid $wpage.e$tag -sticky w
			
			set bstr $help($tag)
			::balloonhelp::balloonforwindow $wpage.l$tag $bstr
			::balloonhelp::balloonforwindow $wpage.e$tag $bstr
		    }
		}
	    }
	}
    }    
    if {[info exists state(lat)] && [info exists state(lon)]} {
	$wpage.mapquest state {!disabled}
	set url "http://www.mapquest.com/maps/map.adp?latlongtype=decimal&latitude=$state(lat)&longitude=$state(lon)"
	$wpage.mapquest configure -command [list ::Utils::OpenURLInBrowser $url]
    }
}