[bknr-cvs] ksprotte changed trunk/projects/bos/
BKNR Commits
bknr at bknr.net
Mon Jul 28 10:48:50 UTC 2008
Revision: 3653
Author: ksprotte
URL: http://bknr.net/trac/changeset/3653
poi-handlers changed to get them up-to-date with hunchentoot - all the old functionality is working now again
A trunk/projects/bos/payment-website/static/MochiKit
U trunk/projects/bos/payment-website/static/cms.js
U trunk/projects/bos/web/poi-handlers.lisp
U trunk/projects/bos/web/webserver.lisp
Added: trunk/projects/bos/payment-website/static/MochiKit
===================================================================
--- trunk/projects/bos/payment-website/static/MochiKit (rev 0)
+++ trunk/projects/bos/payment-website/static/MochiKit 2008-07-28 10:48:50 UTC (rev 3653)
@@ -0,0 +1 @@
+link ../../../../thirdparty/MochiKit/MochiKit
\ No newline at end of file
Property changes on: trunk/projects/bos/payment-website/static/MochiKit
___________________________________________________________________
Name: svn:special
+ *
Modified: trunk/projects/bos/payment-website/static/cms.js
===================================================================
--- trunk/projects/bos/payment-website/static/cms.js 2008-07-28 08:48:19 UTC (rev 3652)
+++ trunk/projects/bos/payment-website/static/cms.js 2008-07-28 10:48:50 UTC (rev 3653)
@@ -92,3 +92,9 @@
return true;
}
}
+
+function confirm_delete(field_name, value, confirm_string)
+{
+ $(field_name).value = value;
+ return confirm(confirm_string);
+}
\ No newline at end of file
Modified: trunk/projects/bos/web/poi-handlers.lisp
===================================================================
--- trunk/projects/bos/web/poi-handlers.lisp 2008-07-28 08:48:19 UTC (rev 3652)
+++ trunk/projects/bos/web/poi-handlers.lisp 2008-07-28 10:48:50 UTC (rev 3653)
@@ -1,11 +1,10 @@
-
(in-package :bos.web)
(enable-interpol-syntax)
(defclass make-poi-handler (page-handler)
())
-
+
(defmethod handle ((handler make-poi-handler))
(with-query-params (name)
(cond
@@ -64,7 +63,8 @@
(< -1 (+ shift-by old-position) (length new-images))))
(setf (nth old-position new-images) (nth (+ shift-by old-position) new-images))
(setf (nth (+ shift-by old-position) new-images) tmp)
- (change-slot-values poi 'bos.m2::images new-images)))
+ (with-transaction ("setf poi-images")
+ (setf (poi-images poi) new-images))))
(with-bos-cms-page (:title "Edit POI")
(content-language-chooser)
(unless (poi-complete poi language)
@@ -111,19 +111,19 @@
for index from 1 by 1
do (html (:td ((:a :href (format nil "/edit-poi-image/~a?poi=~A" (store-object-id image) (store-object-id poi)))
((:img :border "0" :src (format nil "/image/~a/thumbnail,,55,55" (store-object-id image)))))
- :br
- (if (eql index 1)
- (html ((:img :src "/images/trans.gif" :width "16")))
- (html ((:a :href (format nil "/edit-poi/~A?shift=~A&shift-by=-1"
- (store-object-id poi)
- (store-object-id image)))
- ((:img :border "0" :src "/images/pfeil-l.gif")))))
- ((:img :src "/images/trans.gif" :width "23"))
- (unless (eql index (length (poi-images poi)))
- (html ((:a :href (format nil "/edit-poi/~A?shift=~A&shift-by=1"
- (store-object-id poi)
- (store-object-id image)))
- ((:img :border "0" :src "/images/pfeil-r.gif"))))))))))
+ :br
+ (if (eql index 1)
+ (html ((:img :src "/images/trans.gif" :width "16")))
+ (html ((:a :href (format nil "/edit-poi/~A?shift=~A&shift-by=-1"
+ (store-object-id poi)
+ (store-object-id image)))
+ ((:img :border "0" :src "/images/pfeil-l.gif")))))
+ ((:img :src "/images/trans.gif" :width "23"))
+ (unless (eql index (length (poi-images poi)))
+ (html ((:a :href (format nil "/edit-poi/~A?shift=~A&shift-by=1"
+ (store-object-id poi)
+ (store-object-id image)))
+ ((:img :border "0" :src "/images/pfeil-r.gif"))))))))))
(unless (eql 6 (length (poi-images poi)))
(html
:br
@@ -139,12 +139,14 @@
((:input :type "file" :name "image-file"))
:br
(submit-button "upload-airal" "upload-airal")))))
- (:tr (:td "panorama view")
+ (:tr (:td "panorama view"
+ ((:input :id "panorama-id" :type "hidden" :name "panorama-id")))
(:td (dolist (panorama (poi-panoramas poi))
(html (:princ-safe (format-date-time (blob-timestamp panorama)))
((:a :href (format nil "/image/~D" (store-object-id panorama)) :target "_new" :class "cmslink")
" view ")
- (submit-button "delete-panorama" "delete-panorama" :confirm "Really delete this panorama image?")
+ (submit-button "delete-panorama" "delete-panorama"
+ :formcheck #?"javascript:confirm_delete('panorama-id', $((store-object-id panorama)), 'Really delete this panorama image?')")
:br))
(html "Upload new panorama view"
((:input :type "file" :name "image-file"))
@@ -191,28 +193,30 @@
(unless uploaded-file
(error "no file uploaded in upload handler"))
(with-image-from-upload* (uploaded-file)
- (unless (and (eql (cl-gd:image-width) *poi-image-width*)
- (eql (cl-gd:image-height) *poi-image-height*))
- (with-bos-cms-page (:title "Invalid image size")
- (:h2 "Invalid image size")
- (:p "The image needs to be "
- (:princ-safe *poi-image-width*) " pixels wide and "
- (:princ-safe *poi-image-height*) " pixels high. Your uploaded image is "
- (:princ-safe (cl-gd:image-width)) " pixels wide and "
- (:princ-safe (cl-gd:image-height)) " pixels high. Please use an image editor "
- "to resize the image and upload it again.")
- (:p (cmslink (edit-object-url poi) "Back to POI")))
- (return-from handle-object-form t)))
- (change-slot-values poi 'airals (list (import-image (upload-pathname uploaded-file)
- :class-name 'store-image))))
- (redirect (format nil "/edit-poi/~D"
- (store-object-id poi))))
+ (cond
+ ((and (eql (cl-gd:image-width) *poi-image-width*)
+ (eql (cl-gd:image-height) *poi-image-height*))
+ (with-transaction ("set airals")
+ (setf (poi-airals poi) (print (list (import-image uploaded-file :class-name 'store-image)))))
+ (redirect (format nil "/edit-poi/~D"
+ (store-object-id poi))))
+ (t
+ (with-bos-cms-page (:title "Invalid image size")
+ (:h2 "Invalid image size")
+ (:p "The image needs to be "
+ (:princ-safe *poi-image-width*) " pixels wide and "
+ (:princ-safe *poi-image-height*) " pixels high. Your uploaded image is "
+ (:princ-safe (cl-gd:image-width)) " pixels wide and "
+ (:princ-safe (cl-gd:image-height)) " pixels high. Please use an image editor "
+ "to resize the image and upload it again.")
+ (:p (cmslink (edit-object-url poi) "Back to POI"))))))))
(defmethod handle-object-form ((handler edit-poi-handler)
(action (eql :delete-airal))
(poi poi))
(let ((airals (poi-airals poi)))
- (change-slot-values poi 'airals nil)
+ (with-transaction ("setf poi-airals nil")
+ (setf (poi-airals poi) nil))
(mapc #'delete-object airals))
(redirect (format nil "/edit-poi/~D"
(store-object-id poi))))
@@ -220,7 +224,8 @@
(defmethod handle-object-form ((handler edit-poi-handler)
(action (eql :delete-movie))
(poi poi))
- (change-slot-values poi 'movies nil)
+ (with-transaction ("setf poi-movies nil")
+ (setf (poi-movies poi) nil))
(redirect (format nil "/edit-poi/~D" (store-object-id poi))))
(defmethod handle-object-form ((handler edit-poi-handler)
@@ -229,12 +234,10 @@
(let ((uploaded-file (request-uploaded-file "image-file")))
(unless uploaded-file
(error "no file uploaded in upload handler"))
- (with-image-from-upload* (uploaded-file)
- ; just open the image to make sure that gd can process it
- )
- (change-slot-values poi 'panoramas (cons (import-image (upload-pathname uploaded-file)
- :class-name 'store-image)
- (poi-panoramas poi))))
+ ;; just open the image to make sure that gd can process it
+ (with-image-from-upload* (uploaded-file))
+ (with-transaction ("add poi-panorama")
+ (push (import-image uploaded-file :class-name 'store-image) (poi-panoramas poi))))
(redirect (format nil "/edit-poi/~D"
(store-object-id poi))))
@@ -243,8 +246,9 @@
(poi poi))
(with-query-params (panorama-id)
(let ((panorama (find-store-object (parse-integer panorama-id))))
- (change-slot-values poi 'panoramas (remove panorama (poi-panoramas poi)))
- (mapc #'delete-object panorama)))
+ (with-transaction ("delete poi-panorama")
+ (alexandria:deletef (poi-panoramas poi) panorama))
+ (delete-object panorama)))
(redirect (format nil "/edit-poi/~D"
(store-object-id poi))))
@@ -292,7 +296,7 @@
(return-from handle-object-form t)))
(if poi-image
(blob-from-file poi-image uploaded-file)
- (setq poi-image (import-image (upload-pathname uploaded-file)
+ (setq poi-image (import-image uploaded-file
:class-name 'poi-image
:initargs `(:poi ,poi))))
(redirect (format nil "/edit-poi-image/~D?poi=~D"
@@ -314,8 +318,8 @@
(:td ((:img :src (format nil "/image/~A" (store-object-id poi-image))))))
(:tr (:td "upload new image")
(:td ((:input :type "file" :name "image-file"))
- :br
- (submit-button "upload" "upload")))
+ :br
+ (submit-button "upload" "upload")))
(:tr (:td "title")
(:td (text-field "title"
:value (slot-string poi-image 'title language))))
@@ -364,10 +368,10 @@
:key (lambda (poi) (store-object-last-change poi 1)))
(reduce #'max last-paid-contracts
:key (lambda (contract) (store-object-last-change contract 0))))))
- (hunchentoot:handle-if-modified-since timestamp)
+ (hunchentoot:handle-if-modified-since timestamp)
(setf (hunchentoot:header-out :last-modified)
(hunchentoot:rfc-1123-date timestamp))
- (with-http-response (:content-type "text/html; charset=UTF-8")
+ (with-http-response (:content-type "text/html; charset=UTF-8")
(with-http-body ()
(html
((:script :language "JavaScript")
@@ -409,12 +413,12 @@
(format-image (image)
(with-element "image"
(attribute "id" (princ-to-string (store-object-id image)))
- (when (typep image 'poi-image)
+ (when (typep image 'poi-image)
(attribute "title" (slot-string image 'title language))
- (attribute "subtitle" (slot-string image 'subtitle language))
+ (attribute "subtitle" (slot-string image 'subtitle language))
(with-element "description" (text (slot-string image 'description language))))
(with-element "url" (text (format nil "http://createrainforest.org/image/~D"
- (store-object-id image))))
+ (store-object-id image))))
(with-element "width" (text (princ-to-string (store-image-width image))))
(with-element "height" (text (princ-to-string (store-image-height image)))))))
(with-accessors ((id store-object-id)
@@ -480,19 +484,19 @@
;; images
(with-element "tr"
(dolist (image images)
- (img-td image)))
+ (img-td image)))
;; titles
(with-element "tr"
(dolist (image images)
(img-td-title image)))))
(handler-case
(with-xml-output (make-string-sink)
- (with-element "html"
+ (with-element "html"
(with-element "head")
(with-element "body"
(with-element "table"
(attribute "cellspacing" "0") (attribute "width" "500") (attribute "cellpadding" "5") (attribute "border" "0")
- (attribute "style" "background-color: rgb(186, 186, 186);")
+ (attribute "style" "background-color: rgb(186, 186, 186);")
(with-element "tbody"
(with-element "tr"
(with-element "td"
@@ -566,7 +570,7 @@
(defmethod handle-object ((handler poi-xml-handler) poi)
(let ((timestamp (store-object-last-change poi 1)))
- (hunchentoot:handle-if-modified-since timestamp)
+ (hunchentoot:handle-if-modified-since timestamp)
(setf (hunchentoot:header-out :last-modified)
(hunchentoot:rfc-1123-date timestamp))
(with-query-params ((lang "en"))
@@ -580,7 +584,7 @@
(defmethod handle-object ((handler poi-kml-handler) poi)
(with-query-params ((lang "en"))
- (with-xml-response ()
+ (with-xml-response ()
(with-namespace (nil "http://earth.google.com/kml/2.1")
(with-element "kml"
(write-poi-kml poi lang))))))
@@ -610,5 +614,3 @@
(with-element "href" (text (format nil "http://~a/static/Orang_weiss.png" (website-host)))))))
(kml-region (make-rectangle2 (list 0 0 +width+ +width+)) '(:min 600 :max -1))
(mapc #'(lambda (poi) (write-poi-kml poi lang)) relevant-pois))))))))
-
-
Modified: trunk/projects/bos/web/webserver.lisp
===================================================================
--- trunk/projects/bos/web/webserver.lisp 2008-07-28 08:48:19 UTC (rev 3652)
+++ trunk/projects/bos/web/webserver.lisp 2008-07-28 10:48:50 UTC (rev 3653)
@@ -225,7 +225,7 @@
:authorizer (make-instance 'bos-authorizer)
:site-logo-url "/images/bos-logo.gif"
:style-sheet-urls '("/static/cms.css")
- :javascript-urls '("/static/cms.js" "/static/tiny_mce/tiny_mce.js"))
+ :javascript-urls '("/static/cms.js" "/static/tiny_mce/tiny_mce.js" "/static/MochiKit/MochiKit.js"))
(publish-directory :prefix "/static/"
:destination (merge-pathnames "static/" website-directory))
More information about the Bknr-cvs
mailing list