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))) ,@body) `(progn ,@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))))