1 | (use html-stream svnwiki-extensions-support stream-ext srfi-40 format-modular posix srfi-1) |
---|
2 | |
---|
3 | (define (googlemap-update env) |
---|
4 | (let-from-environment env (path-in path path-out) |
---|
5 | (when (directory? (svnwiki-make-pathname path-in path)) |
---|
6 | (svnwiki-report-progress env "Updating map: ~A~%" path) |
---|
7 | (write-file-with-tmp |
---|
8 | (svnwiki-make-pathname path "xsvnwiki-googlemap" "index") |
---|
9 | "text/html" |
---|
10 | path-out |
---|
11 | (map-html env)) |
---|
12 | (write-file-with-tmp |
---|
13 | (svnwiki-make-pathname path "xsvnwiki-googlemap" "data") |
---|
14 | "text/xml" |
---|
15 | path-out |
---|
16 | (map-data env))))) |
---|
17 | |
---|
18 | (define (map-html env) |
---|
19 | (html-stream |
---|
20 | "<!DOCTYPE html PUBLIC \\-//W3C//DTD XHTML 1.0 Strict//EN\"" |
---|
21 | " \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">" |
---|
22 | ((html xmlns "http://www.w3.org/1999/xhtml") |
---|
23 | (head |
---|
24 | ((meta http-equiv "content-type" content "text/html; charset=utf-8")) |
---|
25 | (title |
---|
26 | (svnwiki-repository-property-get |
---|
27 | "svnwiki:googlemap:title" |
---|
28 | (svnwiki-repository-path env) |
---|
29 | "Map")) |
---|
30 | ((script src (format #f "http://maps.google.com/maps?file=api&v=2&key=~A" |
---|
31 | (svnwiki-repository-property-get |
---|
32 | "svnwiki:googlemap:key" |
---|
33 | (svnwiki-repository-path env) |
---|
34 | "")) |
---|
35 | type "text/javascript")) |
---|
36 | ((script type "text/javascrit") *map-js*)) |
---|
37 | ((body onload "load()" onunload "GUnload()") |
---|
38 | ((div id "map" style "width: 100%; height: 600px")))))) |
---|
39 | |
---|
40 | (define *map-js* |
---|
41 | #<<EOJS |
---|
42 | //<![CDATA[ |
---|
43 | function addMarker( point, data ) { |
---|
44 | var file = data.getAttribute("file"); |
---|
45 | var title = data.getAttribute("title"); |
---|
46 | var marker = new GMarker(point); |
---|
47 | GEvent.addListener(marker, "click", function() { |
---|
48 | marker.openInfoWindowHtml('<a target="_blank" href="../' + file + '">' + title + '</a>'); |
---|
49 | }); |
---|
50 | return marker; |
---|
51 | } |
---|
52 | |
---|
53 | function load() { |
---|
54 | if (GBrowserIsCompatible()) { |
---|
55 | var map = new GMap2(document.getElementById("map")); |
---|
56 | map.addControl(new GSmallMapControl()); |
---|
57 | map.addControl(new GMapTypeControl()); |
---|
58 | map.setCenter(new GLatLng(0, 0), 2); |
---|
59 | GDownloadUrl("users.xml", function(data, responseCode) { |
---|
60 | var xml = GXml.parse(data); |
---|
61 | var markers = xml.documentElement.getElementsByTagName("marker"); |
---|
62 | for (var i = 0; i < markers.length; i++) { |
---|
63 | var point = new GLatLng(parseFloat(markers[i].getAttribute("latitude")), |
---|
64 | parseFloat(markers[i].getAttribute("longitude"))); |
---|
65 | map.addOverlay(addMarker(point, markers[i])); |
---|
66 | } |
---|
67 | }); |
---|
68 | } |
---|
69 | } |
---|
70 | //]]> |
---|
71 | EOJS |
---|
72 | ) |
---|
73 | |
---|
74 | (define (map-data env) |
---|
75 | (let-from-environment env (path-in path) |
---|
76 | (html-stream |
---|
77 | (format #f "<markers>") |
---|
78 | (stream-concatenate |
---|
79 | (stream-map |
---|
80 | (lambda (file) |
---|
81 | (let ((props (map (cut svnwiki-repository-property-get |
---|
82 | <> |
---|
83 | (svnwiki-make-pathname (list path-in path) file) |
---|
84 | #f) |
---|
85 | (list "svnwiki:googlemap:longitude" |
---|
86 | "svnwiki:googlemap:longitude")))) |
---|
87 | (if (every string? props) |
---|
88 | (format #f |
---|
89 | "<marker latitude=\"~A\" longitude=\"~A\" file=\"~A\" title=\"~A\"/>" |
---|
90 | (car props) |
---|
91 | (cadr props) |
---|
92 | file |
---|
93 | (get-title path-in (svnwiki-make-pathname path file))) |
---|
94 | stream-null))) |
---|
95 | (list->stream |
---|
96 | (directory (svnwiki-make-pathname path-in path))))) |
---|
97 | (format #f "</markers>")))) |
---|
98 | |
---|
99 | (svnwiki-extension-define 'update-notify 'googlemap googlemap-update) |
---|