[bknr-cvs] hans changed deployed/bos/

[BKNR Commits]

Revision: 4330
Author: hans
URL: http://bknr.net/trac/changeset/4330

merge kml changes
U   deployed/bos/bknr/web/src/web/web-macros.lisp
U   deployed/bos/projects/bos/web/kml-handlers.lisp
U   deployed/bos/projects/bos/web/kml-utils.lisp

Modified: deployed/bos/bknr/web/src/web/web-macros.lisp
===================================================================
--- deployed/bos/bknr/web/src/web/web-macros.lisp	2009-03-03 22:27:55 UTC (rev 4329)
+++ deployed/bos/bknr/web/src/web/web-macros.lisp	2009-03-03 22:37:01 UTC (rev 4330)
@@ -104,7 +104,7 @@
 
 (defvar *xml-sink*)
 
-(defmacro with-xml-response ((&key (content-type "text/xml; charset=utf-8") root-element xsl-stylesheet-name)
+(defmacro with-xml-response ((&key (content-type "text/xml; charset=utf-8") root-element xsl-stylesheet-name xmlns)
                              &body body)
   `(with-http-response (:content-type ,content-type)
      (with-query-params (download)
@@ -114,10 +114,12 @@
      (with-output-to-string (s)
        (let ((*xml-sink* (cxml:make-character-stream-sink s :canonical nil)))
          (cxml:with-xml-output *xml-sink*
-           ,(when xsl-stylesheet-name
-                  `(sax:processing-instruction *xml-sink* "xml-stylesheet"
-                                               ,(format nil "type=\"text/xsl\" href=\"~A\"" xsl-stylesheet-name)))
+           ,@(when xsl-stylesheet-name
+                  `((sax:processing-instruction *xml-sink* "xml-stylesheet"
+                                                ,(format nil "type=\"text/xsl\" href=\"~A\"" xsl-stylesheet-name))))
            ,(if root-element
                 `(cxml:with-element ,root-element
+                   ,@(when xmlns
+                           `((cxml:attribute "xmlns" ,xmlns)))
                    , at body)
                 `(progn , at body)))))))
\ No newline at end of file

Modified: deployed/bos/projects/bos/web/kml-handlers.lisp
===================================================================
--- deployed/bos/projects/bos/web/kml-handlers.lisp	2009-03-03 22:27:55 UTC (rev 4329)
+++ deployed/bos/projects/bos/web/kml-handlers.lisp	2009-03-03 22:37:01 UTC (rev 4330)
@@ -218,7 +218,7 @@
         (contract (when sponsor (first (sponsor-contracts sponsor)))))
     ;; only the first contract of SPONSOR will be shown
     (with-xml-response (:content-type #+nil "text/xml" "application/vnd.google-earth.kml+xml; charset=utf-8"
-                                      :root-element "kml")
+                                      :root-element "kml" :xmlns "http://www.opengis.net/kml/2.2")
       (with-query-params ((lang "en"))
         (with-element "Document"
           (with-element "name" (text "BOS"))
@@ -229,12 +229,12 @@
             (with-element "longitude" (text "116.975859"))
             (with-element "latitude" (text "-1.044691"))
             (with-element "altitude" (text "0"))
-            (with-element "range" (text "11000"))
+            (with-element "heading" (text "0"))
             (with-element "tilt" (text "0"))
-            (with-element "heading" (text "0")))
+            (with-element "range" (text "11000")))
           (with-element "Folder"
-            (attribute "name" (dictionary-entry "Sat-Images" lang))
-            (attribute "open" "1")
+            (with-element "name" (text (dictionary-entry "Sat-Images" lang)))
+            (with-element "open" (text "1"))
             (dolist (sat-layer (sort (copy-list (class-instances 'sat-layer))
                                      #'< :key #'year))
               (kml-network-link (format nil "http://~a/sat-root-kml?name=~A" (website-host) (name sat-layer))
@@ -293,7 +293,7 @@
     (setf (hunchentoot:header-out :last-modified)
           (hunchentoot:rfc-1123-date timestamp))
     (with-xml-response (:content-type "application/vnd.google-earth.kml+xml; charset=utf-8"
-                                      :root-element "kml")
+                                      :root-element "kml" :xmlns "http://www.opengis.net/kml/2.2")
       (with-query-params ((lang "en"))
         (with-element "Document"
           (with-element "name" (text "Country-Stats"))          
@@ -348,7 +348,7 @@
 (defmethod handle-object ((handler look-at-allocation-area-handler)
                           (area allocation-area))
   (with-xml-response (:content-type "application/vnd.google-earth.kml+xml; charset=utf-8"
-                                    :root-element "kml")
+                                    :root-element "kml" :xmlns "http://www.opengis.net/kml/2.2")
     (with-element "Document"
       (with-element "name" (text (format nil "allocation-area ~D" (store-object-id area))))
       (kml-region (make-rectangle2 (allocation-area-bounding-box2 area))

Modified: deployed/bos/projects/bos/web/kml-utils.lisp
===================================================================
--- deployed/bos/projects/bos/web/kml-utils.lisp	2009-03-03 22:27:55 UTC (rev 4329)
+++ deployed/bos/projects/bos/web/kml-utils.lisp	2009-03-03 22:37:01 UTC (rev 4330)
@@ -281,10 +281,10 @@
   ;; http-query could be added to &key args
   (with-element "NetworkLink"
     (when name (with-element "name" (text name)))
+    (when hide-children
+      (kml-hide-children-style))
     (when rect (kml-region rect lod))
     (when look-at (funcall look-at))
-    (when hide-children
-      (kml-hide-children-style))
     (when fly-to-view (with-element "flyToView" (text "1")))
     (kml-link href :refresh-on-region (and rect t))))