- bknr-cvs@common-lisp.net - mailman3.common-lisp.net

[bknr-cvs] ksprotte changed trunk/projects/bos/m2/poi.lisp
by BKNR Commits 03 Sep '08

03 Sep '08

Revision: 3780 Author: ksprotte URL: http://bknr.net/trac/changeset/3780 more defensive coding in MAKE-POI-JAVASCRIPT to avoid generating invalid javascript (which is hard to debug) U trunk/projects/bos/m2/poi.lisp Modified: trunk/projects/bos/m2/poi.lisp =================================================================== --- trunk/projects/bos/m2/poi.lisp 2008-09-03 12:56:00 UTC (rev 3779) +++ trunk/projects/bos/m2/poi.lisp 2008-09-03 14:51:57 UTC (rev 3780) @@ -110,7 +110,8 @@ :documentation "liste aller poi-medien, wie poi-image, poi-airal ..."))) -(defmethod convert-slot-value-while-restoring ((object poi) (slot-name (eql 'published)) published) +(defmethod convert-slot-value-while-restoring ((object poi) (slot-name (eql 'published)) + published) (setf (slot-value object 'published-web) published)) (deftransaction make-poi (name &rest rest &key area language title subtitle description) @@ -229,7 +230,13 @@ (when (poi-panoramas poi) (format t "poi.panoramas = [ ~{~D~^, ~} ];~%" (mapcar #'store-object-id (poi-panoramas poi)))) (when (poi-movies poi) - (format t "poi.movies = [ ~{~S~^, ~} ];~%" (mapcar #'poi-movie-url (poi-movies poi)))) + (format t "poi.movies = [ ~{~S~^, ~} ];~%" + (mapcar #'(lambda (movie) + (assert (stringp (poi-movie-url movie)) nil + "POI-MOVIE-URL of ~S is ~S, but should be a string" + movie (poi-movie-url movie)) + (poi-movie-url movie)) + (poi-movies poi)))) (loop for slot-name in '(title subtitle description) for javascript-name in '("imageueberschrift" "imageuntertitel" "imagetext") for slot-values = (mapcar (lambda (image)

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/
by BKNR Commits 03 Sep '08

03 Sep '08

Revision: 3779 Author: ksprotte URL: http://bknr.net/trac/changeset/3779 :published-web und :published-earth f?\195?\188r POIs U trunk/projects/bos/m2/packages.lisp U trunk/projects/bos/m2/poi.lisp U trunk/projects/bos/web/poi-handlers.lisp Modified: trunk/projects/bos/m2/packages.lisp =================================================================== --- trunk/projects/bos/m2/packages.lisp 2008-09-03 11:43:11 UTC (rev 3778) +++ trunk/projects/bos/m2/packages.lisp 2008-09-03 12:56:00 UTC (rev 3779) @@ -221,7 +221,8 @@ #:poi-name #:find-poi #:all-pois - #:poi-published + #:poi-published-web + #:poi-published-earth #:poi-area #:poi-icon #:poi-media Modified: trunk/projects/bos/m2/poi.lisp =================================================================== --- trunk/projects/bos/m2/poi.lisp 2008-09-03 11:43:11 UTC (rev 3778) +++ trunk/projects/bos/m2/poi.lisp 2008-09-03 12:56:00 UTC (rev 3779) @@ -93,9 +93,12 @@ :index-type string-unique-index :index-reader find-poi :index-values all-pois :documentation "symbolischer name") - (published - :accessor poi-published :initarg :published :initform nil - :documentation "wenn dieses flag nil ist, wird der poi in den uis nicht angezeigt") + (published-web + :accessor poi-published-web :initarg :published-web :initform nil + :documentation "wenn dieses flag nil ist, wird der poi auf der Website nicht angezeigt") + (published-earth + :accessor poi-published-earth :initarg :published-earth :initform nil + :documentation "wenn dieses flag nil ist, wird der poi in Google Earth nicht angezeigt") (area :accessor poi-area :initarg :area :initform nil :documentation "polygon mit den poi-koordinaten") @@ -106,6 +109,10 @@ :accessor poi-media :initarg :media :initform nil :documentation "liste aller poi-medien, wie poi-image, poi-airal ..."))) + +(defmethod convert-slot-value-while-restoring ((object poi) (slot-name (eql 'published)) published) + (setf (slot-value object 'published-web) published)) + (deftransaction make-poi (name &rest rest &key area language title subtitle description) (declare (ignore area)) (assert (if (or title subtitle description) language t) nil @@ -116,10 +123,12 @@ (defmethod destroy-object :before ((poi poi)) (mapc #'delete-object (poi-media poi))) -(deftransaction update-poi (poi &key published icon area) - (check-type published boolean) +(deftransaction update-poi (poi &key published-web published-earth icon area) + (check-type published-web boolean) + (check-type published-earth boolean) (check-type area list) - (setf (poi-published poi) published) + (setf (poi-published-web poi) published-web + (poi-published-earth poi) published-earth) (when icon (setf (poi-icon poi) icon)) (when area @@ -191,7 +200,7 @@ (format t "var anzahlVerkauft = ~D;~%" (number-of-sold-sqm)) (format t "var pois = new Array;~%") (dolist (poi (sort (remove-if #'(lambda (poi) (or (not (poi-complete poi language)) - (not (poi-published poi)))) + (not (poi-published-web poi)))) (store-objects-with-class 'poi)) #'(lambda (poi-1 poi-2) (string-lessp (slot-string poi-1 'title language) (slot-string poi-2 'title language))))) (format t " Modified: trunk/projects/bos/web/poi-handlers.lisp =================================================================== --- trunk/projects/bos/web/poi-handlers.lisp 2008-09-03 11:43:11 UTC (rev 3778) +++ trunk/projects/bos/web/poi-handlers.lisp 2008-09-03 12:56:00 UTC (rev 3779) @@ -73,7 +73,8 @@ (:tr (:td "name") (:td (:princ-safe (poi-name poi)))) (:tr (:td "published") - (:td (checkbox-field "published" "published" :checked (poi-published poi)))) + (:td (checkbox-field "published-web" "published-web" :checked (poi-published-web poi)) " " + (checkbox-field "published-earth" "published-earth" :checked (poi-published-earth poi)))) (:tr (:td "title") (:td (text-field "title" :value (slot-string poi 'title language)))) @@ -88,10 +89,11 @@ (:tr (:td "location") (:td (flet ((format-chosen-url () (encode-urlencoded - (format nil "~A?action=save&language=~A&~:[~;published=on~]" + (format nil "~A?action=save&language=~A&~:[~;published-web=on~]&~:[~;published-earth=on~]" (hunchentoot:script-name*) language - (poi-published poi))))) + (poi-published-web poi) + (poi-published-earth poi))))) (cond ((poi-area poi) (html (:princ-safe (format nil "~D/~D " (first (poi-area poi)) (second (poi-area poi))))) @@ -170,7 +172,8 @@ (defmethod handle-object-form ((handler edit-poi-handler) (action (eql :save)) (poi poi)) - (with-query-params ((published nil boolean) + (with-query-params ((published-web nil boolean) + (published-earth nil boolean) title subtitle description language (x nil integer) (y nil integer) @@ -181,7 +184,8 @@ :subtitle subtitle :description description) (update-poi poi - :published published + :published-web published-web + :published-earth published-earth :area (when (and x y) (list x y)) :icon icon) (with-bos-cms-page (:title "POI has been updated") @@ -592,7 +596,7 @@ ()) (defmethod handle ((handler poi-kml-all-handler)) - (let* ((relevant-pois (remove-if-not #'(lambda (poi) (and (poi-area poi) (poi-published poi))) + (let* ((relevant-pois (remove-if-not #'(lambda (poi) (and (poi-area poi) (poi-published-earth poi))) (class-instances 'poi))) (pois-last-change (reduce #'max relevant-pois :key (lambda (poi) (store-object-last-change poi 1))))) (hunchentoot:handle-if-modified-since pois-last-change)

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/web/poi-handlers.lisp
by BKNR Commits 03 Sep '08

03 Sep '08

Revision: 3778 Author: ksprotte URL: http://bknr.net/trac/changeset/3778 link to show POI in microsite more prominent U trunk/projects/bos/web/poi-handlers.lisp Modified: trunk/projects/bos/web/poi-handlers.lisp =================================================================== --- trunk/projects/bos/web/poi-handlers.lisp 2008-09-03 11:33:06 UTC (rev 3777) +++ trunk/projects/bos/web/poi-handlers.lisp 2008-09-03 11:43:11 UTC (rev 3778) @@ -66,12 +66,12 @@ (html (:h2 "This POI is not complete in the current language - Please check that " "the location and all text fields are set and that at least 6 images " "have been uploaded."))) + (:p (cmslink (format nil "/poi-xml/~D?lang=~A" (store-object-id poi) language) + (:format "show this POI in ~A microsite" (string-upcase language)))) ((:form :method "POST" :enctype "multipart/form-data") ((:table :border "1") (:tr (:td "name") - (:td (:princ-safe (poi-name poi)) - " " - (cmslink (format nil "/poi-xml/~D?lang=~A" (store-object-id poi) language) "[view]"))) + (:td (:princ-safe (poi-name poi)))) (:tr (:td "published") (:td (checkbox-field "published" "published" :checked (poi-published poi)))) (:tr (:td "title")

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/web/poi-handlers.lisp
by BKNR Commits 03 Sep '08

03 Sep '08

Revision: 3777 Author: ksprotte URL: http://bknr.net/trac/changeset/3777 poi-xml-handler is now ready for ptviewer's /poi-xml/PTDefault.html requests by using :query-function #'find-poi-or-ptdefault U trunk/projects/bos/web/poi-handlers.lisp Modified: trunk/projects/bos/web/poi-handlers.lisp =================================================================== --- trunk/projects/bos/web/poi-handlers.lisp 2008-09-03 11:04:05 UTC (rev 3776) +++ trunk/projects/bos/web/poi-handlers.lisp 2008-09-03 11:33:06 UTC (rev 3777) @@ -441,9 +441,14 @@ (with-media ("movie" "Video") (with-element "url" (text (poi-movie-url movie)))))))))) +(defun find-poi-or-ptdefault (string) + (if (string= string "PTDefault.html") + :ptdefault + (find-poi string))) + (defclass poi-xml-handler (object-handler) () - (:default-initargs :object-class 'poi :query-function #'find-poi)) + (:default-initargs :query-function #'find-poi-or-ptdefault)) (defmethod handle-object ((handler poi-xml-handler) poi) @@ -455,6 +460,10 @@ (with-xml-response (:xsl-stylesheet-name "/static/poi.xsl") (write-poi-xml poi lang))))) +(defmethod handle-object ((handler poi-xml-handler) (poi (eql :ptdefault))) + "ptviewer will request /poi-xml/PTDefault.html" + ) + ;;; poi-kml-handler (defun poi-description-google-earth (poi language &key (image-width 120)) (labels ((website-path (path &rest args)

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/payment-website/static/poi.xsl
by BKNR Commits 03 Sep '08

03 Sep '08

Revision: 3776 Author: ksprotte URL: http://bknr.net/trac/changeset/3776 replaced js Pano by ptviewer in microsite U trunk/projects/bos/payment-website/static/poi.xsl Modified: trunk/projects/bos/payment-website/static/poi.xsl =================================================================== --- trunk/projects/bos/payment-website/static/poi.xsl 2008-09-03 08:23:07 UTC (rev 3775) +++ trunk/projects/bos/payment-website/static/poi.xsl 2008-09-03 11:04:05 UTC (rev 3776) @@ -74,15 +74,15 @@ <xsl:variable name="height"><xsl:value-of select="image/height"/></xsl:variable> <div class="accordion_toggle"><xsl:value-of select="@title"/>:<xsl:value-of select="@subtitle"/></div> <div class="accordion_content"> - <div class="scrollpane" style="border: 1px solid black; width: 600px; - height:{$height}px; background-image: url({$url}); - background-position: -690px 0px; background-repeat:repeat-x;" - id="pano-{$id}"></div> - <script type="text/javascript"> - var myPano = new Pano(); - myPano.scrollPano('<xsl:value-of select="image/url"/>', 690, - <xsl:value-of select="image/height"/>, 'pano-<xsl:value-of select="image/@id"/>'); - </script> + <div class="scrollpane" style="border: 1px solid black; width: 600px; height: {$height div 2}px"> + <applet archive="/static/ptviewer.jar" + code="ptviewer.class" + width="600" + height="{$height div 2}"> + <param name="file" value="/image/{$id}"/> + <param name="quality" value="3"/> + </applet> + </div> </div> </xsl:if> <xsl:if test="@type='movie'">

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/payment-website/static/poi.xsl
by BKNR Commits 03 Sep '08

03 Sep '08

Revision: 3775 Author: ksprotte URL: http://bknr.net/trac/changeset/3775 poi.xsl indentation cleanup U trunk/projects/bos/payment-website/static/poi.xsl Modified: trunk/projects/bos/payment-website/static/poi.xsl =================================================================== --- trunk/projects/bos/payment-website/static/poi.xsl 2008-09-02 15:59:30 UTC (rev 3774) +++ trunk/projects/bos/payment-website/static/poi.xsl 2008-09-03 08:23:07 UTC (rev 3775) @@ -1,47 +1,48 @@ <?xml version="1.0" encoding="UTF-8"?> <xsl:stylesheet version="2.0" -xmlns:xsl="http://www.w3.org/1999/XSL/Transform"> - <xsl:output method="html" doctype-system="http://www.w3.org/TR/html4/strict.dtd" doctype-public="-//W3C//DTD HTML 4.01//EN" indent="yes" /> + xmlns:xsl="http://www.w3.org/1999/XSL/Transform"> + <xsl:output method="html" doctype-system="http://www.w3.org/TR/html4/strict.dtd" + doctype-public="-//W3C//DTD HTML 4.01//EN" indent="yes" /> <xsl:template match="/"> <html> - <head> - <meta http-equiv="Content-Type" content="text/html; charset=UTF-8"/> - <link href="/static/poi/bos_style.css" rel="stylesheet"> - </link> - <link href="/static/poi/highslide.css" rel="stylesheet"> - </link> - <link href="http://createrainforest.org/rss/news" rel="alternate" title="RSS Feed" type="application/rss+xml"> - </link> - <script type="text/javascript" src="/static/poi/prototype.js"></script> - <script type="text/javascript" src="/static/poi/effects.js"></script> - <script type="text/javascript" src="/static/poi/accordion.js"></script> - <script type="text/javascript" src="/static/poi/highslide.js"></script> - <script type="text/javascript" src="/static/poi/panorama.js"></script> - <script type="text/javascript" src="/static/poi/functions.js"></script> - <title><xsl:value-of select="poi/@title"/></title> - </head> - <body> - <div id="content"> - <div id="header"> - <div id="menue_banner"> - <div id="menue_header_main"> - <div class="menue">|</div> - <xsl:apply-templates select="poi/menu/entry" /> - + <head> + <meta http-equiv="Content-Type" content="text/html; charset=UTF-8"/> + <link href="/static/poi/bos_style.css" rel="stylesheet"> + </link> + <link href="/static/poi/highslide.css" rel="stylesheet"> + </link> + <link href="http://createrainforest.org/rss/news" rel="alternate" title="RSS Feed" + type="application/rss+xml"> + </link> + <script type="text/javascript" src="/static/poi/prototype.js"></script> + <script type="text/javascript" src="/static/poi/effects.js"></script> + <script type="text/javascript" src="/static/poi/accordion.js"></script> + <script type="text/javascript" src="/static/poi/highslide.js"></script> + <script type="text/javascript" src="/static/poi/panorama.js"></script> + <script type="text/javascript" src="/static/poi/functions.js"></script> + <title><xsl:value-of select="poi/@title"/></title> + </head> + <body> + <div id="content"> + <div id="header"> + <div id="menue_banner"> + <div id="menue_header_main"> + <div class="menue">|</div> + <xsl:apply-templates select="poi/menu/entry" /> + + </div> + </div> </div> + <div id="content_main"> + <div class="description_content"> + <div class="description_header"><xsl:value-of select="poi/@title"/></div> + <div class="description_subheader"><xsl:value-of select="poi/@subtitle"/></div> + <xsl:value-of select="poi/description"/> </div> + <xsl:apply-templates select="poi/media" /> + </div> + <div class="clearer"></div> </div> - </div> - <div id="content_main"> - <div class="description_content"> - <div class="description_header"><xsl:value-of select="poi/@title"/></div> - <div class="description_subheader"><xsl:value-of select="poi/@subtitle"/></div> - <xsl:value-of select="poi/description"/> </div> - <xsl:apply-templates select="poi/media" /> - - </div> - <div class="clearer"></div> - </div> - </body> + </body> </html> </xsl:template>  @@ -63,7 +64,8 @@ <xsl:variable name="width"><xsl:value-of select="image/width"/></xsl:variable> <xsl:variable name="height"><xsl:value-of select="image/height"/></xsl:variable> <div class="accordion_toggle"><xsl:value-of select="@title"/>:<xsl:value-of select="@subtitle"/></div> - <div class="accordion_content"><img class="airal" src="{$url}" alt="{$title}" title="{$title}" height="{$height}" width="{$width}"></img></div> + <div class="accordion_content"><img class="airal" src="{$url}" alt="{$title}" title="{$title}" + height="{$height}" width="{$width}"></img></div> </xsl:if> <xsl:if test="@type='panorama'"> <xsl:variable name="id"><xsl:value-of select="image/@id"/></xsl:variable> @@ -72,10 +74,14 @@ <xsl:variable name="height"><xsl:value-of select="image/height"/></xsl:variable> <div class="accordion_toggle"><xsl:value-of select="@title"/>:<xsl:value-of select="@subtitle"/></div> <div class="accordion_content"> - <div class="scrollpane" style="border: 1px solid black; width: 600px; height:{$height}px; background-image: url({$url}); background-position: -690px 0px; background-repeat:repeat-x;" id="pano-{$id}"></div> + <div class="scrollpane" style="border: 1px solid black; width: 600px; + height:{$height}px; background-image: url({$url}); + background-position: -690px 0px; background-repeat:repeat-x;" + id="pano-{$id}"></div> <script type="text/javascript"> - var myPano = new Pano(); - myPano.scrollPano('<xsl:value-of select="image/url"/>', 690, <xsl:value-of select="image/height"/>, 'pano-<xsl:value-of select="image/@id"/>'); + var myPano = new Pano(); + myPano.scrollPano('<xsl:value-of select="image/url"/>', 690, + <xsl:value-of select="image/height"/>, 'pano-<xsl:value-of select="image/@id"/>'); </script> </div> </xsl:if> @@ -95,14 +101,16 @@ <xsl:template match="entry"> <xsl:variable name="title"><xsl:value-of select="@title"/></xsl:variable> <xsl:variable name="href"><xsl:value-of select="@href"/></xsl:variable> - <div class="menue"><a class="menuelink" href="{$href}" shape="rect" target="_blank" ><xsl:value-of select="$title"/></a></div> + <div class="menue"><a class="menuelink" href="{$href}" shape="rect" target="_blank" > + <xsl:value-of select="$title"/></a></div> <div class="menue">|</div> </xsl:template> <xsl:template match="image"> <xsl:variable name="id"><xsl:value-of select="@id"/></xsl:variable> <xsl:variable name="url"><xsl:value-of select="url"/></xsl:variable> <xsl:variable name="title"><xsl:value-of select="@title"/></xsl:variable> - <a id="thumb{$id}" href="{$url}" class="highslide" onClick="return hs.expand(this)"><img src="{$url}" alt="{$title}" title="{$title}" height="75" width="75"></img></a> + <a id="thumb{$id}" href="{$url}" class="highslide" onClick="return hs.expand(this)"> + <img src="{$url}" alt="{$title}" title="{$title}" height="75" width="75"></img></a> <div class='highslide-caption'> <div class="img-title"><xsl:value-of select="@title"/></div> <div class="img-subtitle"><xsl:value-of select="@subtitle"/></div>

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/m2/map.lisp
by BKNR Commits 02 Sep '08

02 Sep '08

Revision: 3774 Author: ksprotte URL: http://bknr.net/trac/changeset/3774 better to partly revert last commit U trunk/projects/bos/m2/map.lisp Modified: trunk/projects/bos/m2/map.lisp =================================================================== --- trunk/projects/bos/m2/map.lisp 2008-09-02 15:50:01 UTC (rev 3773) +++ trunk/projects/bos/m2/map.lisp 2008-09-02 15:59:30 UTC (rev 3774) @@ -232,11 +232,11 @@ (defun import-tiles (directory) (bknr.datastore::without-sync () - (dolist (px (directory directory #+nil :all #+nil nil)) ; was :ALL NIL used on cmucl? + (dolist (px (directory directory :all nil)) (print px) (let ((x (parse-integer (car (last (pathname-directory px))))) (i 0)) - (dolist (image-pathname (directory px #+nil :all #+nil nil)) + (dolist (image-pathname (directory px :all nil)) (handler-case (let* ((y (parse-integer (pathname-name image-pathname))) (tile (ensure-original-map-tile x y)))

1 0

[bknr-cvs] ksprotte changed trunk/
by BKNR Commits 02 Sep '08

02 Sep '08

Revision: 3773 Author: ksprotte URL: http://bknr.net/trac/changeset/3773 once again STYLE-WARNING fixes U trunk/projects/bos/m2/map.lisp U trunk/thirdparty/unit-test/unit-test.lisp Modified: trunk/projects/bos/m2/map.lisp =================================================================== --- trunk/projects/bos/m2/map.lisp 2008-09-02 15:05:46 UTC (rev 3772) +++ trunk/projects/bos/m2/map.lisp 2008-09-02 15:50:01 UTC (rev 3773) @@ -232,11 +232,11 @@ (defun import-tiles (directory) (bknr.datastore::without-sync () - (dolist (px (directory directory :all nil)) + (dolist (px (directory directory #+nil :all #+nil nil)) ; was :ALL NIL used on cmucl? (print px) (let ((x (parse-integer (car (last (pathname-directory px))))) (i 0)) - (dolist (image-pathname (directory px #+nil :all #+nil nil)) ; was :ALL NIL used on cmucl? + (dolist (image-pathname (directory px #+nil :all #+nil nil)) (handler-case (let* ((y (parse-integer (pathname-name image-pathname))) (tile (ensure-original-map-tile x y))) Modified: trunk/thirdparty/unit-test/unit-test.lisp =================================================================== --- trunk/thirdparty/unit-test/unit-test.lisp 2008-09-02 15:05:46 UTC (rev 3772) +++ trunk/thirdparty/unit-test/unit-test.lisp 2008-09-02 15:50:01 UTC (rev 3773) @@ -134,10 +134,11 @@ (eq (test-result-status test) :crash)) (defmethod print-object ((result test-result) stream) - (format stream "#<TEST-RESULT FORM: ~A STATUS: ~A>" - (test-result-form result) - (test-result-status result) - (test-result-reason result))) + (print-unreadable-object (result stream :type t) + (format stream "FORM: ~A STATUS: ~A REASON: ~A" + (test-result-form result) + (test-result-status result) + (test-result-reason result)))) (defclass test-assert-result (test-result) ())

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/
by BKNR Commits 02 Sep '08

02 Sep '08

Revision: 3772 Author: ksprotte URL: http://bknr.net/trac/changeset/3772 fixed some style-warnings in bos U trunk/projects/bos/m2/map.lisp U trunk/projects/bos/m2/news.lisp U trunk/projects/bos/web/kml-utils.lisp Modified: trunk/projects/bos/m2/map.lisp =================================================================== --- trunk/projects/bos/m2/map.lisp 2008-09-02 14:36:21 UTC (rev 3771) +++ trunk/projects/bos/m2/map.lisp 2008-09-02 15:05:46 UTC (rev 3772) @@ -236,7 +236,7 @@ (print px) (let ((x (parse-integer (car (last (pathname-directory px))))) (i 0)) - (dolist (image-pathname (directory px :all nil)) + (dolist (image-pathname (directory px #+nil :all #+nil nil)) ; was :ALL NIL used on cmucl? (handler-case (let* ((y (parse-integer (pathname-name image-pathname))) (tile (ensure-original-map-tile x y))) Modified: trunk/projects/bos/m2/news.lisp =================================================================== --- trunk/projects/bos/m2/news.lisp 2008-09-02 14:36:21 UTC (rev 3771) +++ trunk/projects/bos/m2/news.lisp 2008-09-02 15:05:46 UTC (rev 3772) @@ -9,7 +9,7 @@ (title :none :initform (make-string-hash-table)) (text :none :initform (make-string-hash-table)))) -(deftransaction make-news-item (&optional language &key title text) +(deftransaction make-news-item (&key language title text) (let ((news-item (make-object 'news-item))) (setf (slot-string news-item 'title language) title) (setf (slot-string news-item 'text language) text) Modified: trunk/projects/bos/web/kml-utils.lisp =================================================================== --- trunk/projects/bos/web/kml-utils.lisp 2008-09-02 14:36:21 UTC (rev 3771) +++ trunk/projects/bos/web/kml-utils.lisp 2008-09-02 15:05:46 UTC (rev 3772) @@ -274,8 +274,9 @@ (with-element "listItemType" (text "checkHideChildren")) (with-element "bgColor" (text "00ffffff"))))) -(defun kml-network-link (href &key rect lod name http-query +(defun kml-network-link (href &key rect lod name fly-to-view hide-children) + ;; http-query could be added to &key args (with-element "NetworkLink" (when name (with-element "name" (text name))) (when rect (kml-region rect lod))

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/
by BKNR Commits 02 Sep '08

02 Sep '08

Revision: 3771 Author: ksprotte URL: http://bknr.net/trac/changeset/3771 POI edit handler is done. Added new generic function: poi-medium-creation-time (and a slot for poi-movie) U trunk/projects/bos/m2/packages.lisp U trunk/projects/bos/m2/poi.lisp U trunk/projects/bos/web/poi-handlers.lisp Modified: trunk/projects/bos/m2/packages.lisp =================================================================== --- trunk/projects/bos/m2/packages.lisp 2008-09-02 14:00:46 UTC (rev 3770) +++ trunk/projects/bos/m2/packages.lisp 2008-09-02 14:36:21 UTC (rev 3771) @@ -210,6 +210,7 @@ #:very-shallow-copy-textual-attributes #:poi-medium #:poi-medium-poi + #:poi-medium-creation-time #:make-poi-medium #:poi-image #:poi-airal Modified: trunk/projects/bos/m2/poi.lisp =================================================================== --- trunk/projects/bos/m2/poi.lisp 2008-09-02 14:00:46 UTC (rev 3770) +++ trunk/projects/bos/m2/poi.lisp 2008-09-02 14:36:21 UTC (rev 3771) @@ -60,6 +60,10 @@ (print-unreadable-object (object stream :type t :identity nil) (format stream "~D" (store-object-id object)))) +(defgeneric poi-medium-creation-time (medium) + (:method ((medium blob)) + (blob-timestamp medium))) + (defmethod destroy-object :before ((poi-medium poi-medium)) (with-slots (poi) poi-medium (when poi @@ -79,7 +83,8 @@ ;;; poi-movie (defpersistent-class poi-movie (poi-medium) - ((url :accessor poi-movie-url :initarg :url :initform nil))) + ((url :accessor poi-movie-url :initarg :url :initform nil) + (created :initform (get-universal-time) :reader poi-medium-creation-time))) ;;; poi (defpersistent-class poi (textual-attributes-mixin) @@ -136,6 +141,9 @@ (defun poi-center-lon-lat (poi) (geo-utm:utm-x-y-to-lon-lat (+ +nw-utm-x+ (poi-center-x poi)) (- +nw-utm-y+ (poi-center-y poi)) +utm-zone+ t)) +(defmethod (setf poi-media) :after (value (poi poi)) + (setf (slot-value poi 'media) (sort (slot-value poi 'media) #'> :key #'poi-medium-creation-time))) + ;;; POI media are stored in one list - for convenience we provide ;;; accessors by type. POI-IMAGES e.g. returns a list of all ;;; POI-IMAGES in the same order as they appear in the media list. The Modified: trunk/projects/bos/web/poi-handlers.lisp =================================================================== --- trunk/projects/bos/web/poi-handlers.lisp 2008-09-02 14:00:46 UTC (rev 3770) +++ trunk/projects/bos/web/poi-handlers.lisp 2008-09-02 14:36:21 UTC (rev 3771) @@ -104,7 +104,7 @@ "[choose]")))))) (:tr (:td "icon") (:td (icon-chooser "icon" (poi-icon poi)))) - (:tr (:td "sat images") + (:tr (:td "images for sat-app") (:td ((:table) (:tr @@ -153,11 +153,20 @@ ((:table :border "1") (dolist (medium (poi-media poi)) (html (:tr (:td (:princ-safe (medium-pretty-type-string medium))) - (:td (:table (medium-handler-preview medium :small t) - (:tr (:td) - (:td (cmslink (format nil "/edit-poi-medium/~D?poi=~D" - (store-object-id medium) (store-object-id poi)) - "edit")))))))))))) + (:td (:table + (:colgroup ((:col :width "80")) ((:col :width "400"))) + (:tr (:td) + (:td (:b (:princ-safe (slot-string medium 'title language "[no title]")))) + (:td (:princ-safe (format-date-time (poi-medium-creation-time medium))))) + (:tr (:td ((:p :style "text-align:center;") + (cmslink (format nil "/edit-poi-medium/~D?poi=~D" + (store-object-id medium) (store-object-id poi)) + "edit")) + ((:p :style "text-align:center;") + (cmslink (format nil "/edit-poi-medium/~D?action=delete&ask-for-confirmation=on&poi=~D" + (store-object-id medium) (store-object-id poi)) + "delete"))) + ((:td :colspan "2") (medium-handler-preview medium :small t)))))))))))) (defmethod handle-object-form ((handler edit-poi-handler) (action (eql :save)) (poi poi)) @@ -201,7 +210,7 @@ (html (cmslink (edit-object-url (poi-medium-poi medium)) "Back to POI") (content-language-chooser) - (:table (medium-handler-preview medium) + (:table (:tr (:td) (:td (medium-handler-preview medium))) (:tr ((:td :colspan "2" :height "10"))) ((:form :method "post" :enctype "multipart/form-data") ((:input :type "hidden" :name "poi" :value poi)) @@ -226,51 +235,48 @@ (submit-button "delete" "delete" :confirm "Really delete?"))))))))) (defgeneric medium-pretty-type-string (medium) - (:method ((medium poi-image)) "POI Image") - (:method ((medium poi-panorama)) "POI Panorama") - (:method ((medium poi-airal)) "POI Airal") - (:method ((medium poi-movie)) "POI Movie")) + (:method ((medium poi-image)) "Image") + (:method ((medium poi-panorama)) "Panorama") + (:method ((medium poi-airal)) "Airal") + (:method ((medium poi-movie)) "Movie")) (defgeneric medium-handler-preview (medium &key small) - (:method ((medium t) &key small) + (:method ((medium poi-medium) &key small) (declare (ignore small)) - (html ((:tr :colspan "2") "No preview"))) + (html "No preview")) (:method ((medium store-image) &key small) "The default method for store-images." (html - (:tr (:td "thumbnail") - (:td ((:a :href (format nil "/image/~A" (store-object-id medium)) - :target "_blank") - ((:img :src (format nil "/image/~A/thumbnail,,55,55" (store-object-id medium))))))) + ((:a :href (format nil "/edit-poi-medium/~A?poi=~A" + (store-object-id medium) (store-object-id (poi-medium-poi medium)))) + ((:img :src (format nil "/image/~A/thumbnail,,70,70" (store-object-id medium))))) (unless small (html - (:tr (:td "full image") - (:td ((:img :src (format nil "/image/~A" (store-object-id medium)))))))))) + (:p "Full size:" + (:br) + ((:img :src (format nil "/image/~A" (store-object-id medium))))))))) (:method ((medium poi-panorama) &key small) - (html - (:tr (:td "thumbnail") - (:td (if small - (html - ((:a :href (format nil "/image/~A" (store-object-id medium)) - :target "_blank") - ((:img :src (format nil "/image/~A/thumbnail,,500,100" (store-object-id medium)))))) - (html - ((:applet :archive "/static/ptviewer.jar" - :code "ptviewer.class" - :width "300" - :height "150") - ((:param :name "file" - :value (format nil "/image/~A" (store-object-id medium)))) - ((:param :name "quality" :value "3"))))))))) + (if small + (html + ((:a :href (format nil "/edit-poi-medium/~A?poi=~A" + (store-object-id medium) (store-object-id (poi-medium-poi medium)))) + ((:img :src (format nil "/image/~A/thumbnail,,500,100" (store-object-id medium)))))) + (html + ((:applet :archive "/static/ptviewer.jar" + :code "ptviewer.class" + :width "300" + :height "150") + ((:param :name "file" + :value (format nil "/image/~A" (store-object-id medium)))) + ((:param :name "quality" :value "3")))))) (:method ((medium poi-movie) &key small) (if small (call-next-method) (html - (:tr (:td "movie") - (:td ((:embed :src (poi-movie-url medium) - :type "application/x-shockwave-flash" - :allowFullScreen "true" - :width "425" :height "344")))))))) + ((:embed :src (poi-movie-url medium) + :type "application/x-shockwave-flash" + :allowFullScreen "true" + :width "425" :height "344")))))) (defgeneric medium-handler-validate-image-size (medium-or-type width height) (:method (medium-or-type width height) @@ -300,12 +306,22 @@ (:princ-safe (format nil "continue editing the ~A" type-string))))))) (defmethod handle-object-form ((handler edit-poi-medium-handler) (action (eql :delete)) (medium poi-medium)) - (let ((poi (poi-medium-poi medium)) - (type-string (medium-pretty-type-string medium))) - (delete-object medium) - (with-bos-cms-page (:title (format nil "~A has been deleted" type-string)) - (:h2 (format nil "The ~A has been deleted" type-string)) - "You may " (cmslink (edit-object-url poi) "continue editing the POI")))) + (with-query-params ((ask-for-confirmation nil boolean)) + (let ((poi (poi-medium-poi medium)) + (type-string (medium-pretty-type-string medium))) + (cond + (ask-for-confirmation + (with-bos-cms-page (:title (format nil "Really delete ~A?" type-string)) + (:h2 (format nil "Really delete ~A?" type-string)) + (:p "Yes, " (cmslink (format nil "/edit-poi-medium/~D?action=delete&poi=~D" + (store-object-id medium) (store-object-id poi)) + "delete it.")) + (:p "No, take me " (cmslink (edit-object-url poi) "back to the POI")))) + (t + (delete-object medium) + (with-bos-cms-page (:title (format nil "~A has been deleted" type-string)) + (:h2 (format nil "The ~A has been deleted" type-string)) + "You may " (cmslink (edit-object-url poi) "continue editing the POI"))))))) (defmethod handle-object-form ((handler edit-poi-medium-handler) (action (eql :upload)) medium) (flet ((make-new-medium (new-medium-type poi)

1 0