[bknr-cvs] ksprotte changed trunk/projects/bos/
BKNR Commits
bknr at bknr.net
Fri Aug 1 15:43:33 UTC 2008
Revision: 3722
Author: ksprotte
URL: http://bknr.net/trac/changeset/3722
checkpoint
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-08-01 15:02:03 UTC (rev 3721)
+++ trunk/projects/bos/m2/packages.lisp 2008-08-01 15:43:33 UTC (rev 3722)
@@ -224,6 +224,7 @@
#:poi-icon
#:poi-media
#:make-poi
+ #:update-poi
#:poi-complete
#:poi-center-x
#:poi-center-y
Modified: trunk/projects/bos/m2/poi.lisp
===================================================================
--- trunk/projects/bos/m2/poi.lisp 2008-08-01 15:02:03 UTC (rev 3721)
+++ trunk/projects/bos/m2/poi.lisp 2008-08-01 15:43:33 UTC (rev 3722)
@@ -102,6 +102,16 @@
(defmethod destroy-object :before ((poi poi))
(mapc #'delete-object (poi-media poi)))
+(deftransaction update-poi (poi &key published icon area)
+ (check-type published boolean)
+ (check-type area list)
+ (setf (poi-published poi) published)
+ (when icon
+ (setf (poi-icon poi) icon))
+ (when area
+ (setf (poi-area poi) area))
+ poi)
+
(defmethod poi-complete ((poi poi) language)
(and (every #'(lambda (slot-name) (slot-string poi slot-name language nil)) '(title subtitle description))
(poi-area poi)
Modified: trunk/projects/bos/web/poi-handlers.lisp
===================================================================
--- trunk/projects/bos/web/poi-handlers.lisp 2008-08-01 15:02:03 UTC (rev 3721)
+++ trunk/projects/bos/web/poi-handlers.lisp 2008-08-01 15:43:33 UTC (rev 3722)
@@ -70,7 +70,8 @@
((: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")))
+ " "
+ (cmslink (format nil "/poi-xml/~D?lang=~A" (store-object-id poi) language) "[view]")))
(:tr (:td "published")
(:td (checkbox-field "published" "published" :checked (poi-published poi))))
(:tr (:td "title")
@@ -90,11 +91,15 @@
(html (:princ-safe (format nil "~D/~D " (first (poi-area poi)) (second (poi-area poi)))))
(cmslink (format nil "map-browser/~A/~A?chosen-url=~A"
(first (poi-area poi)) (second (poi-area poi))
- (encode-urlencoded (format nil "~A?action=save&" (hunchentoot:request-uri*))))
+ (encode-urlencoded (format nil "~A?action=save&~:[~;published=on~]"
+ (hunchentoot:request-uri*)
+ (poi-published poi))))
"[relocate]"))
(t
(cmslink (format nil "map-browser/?chosen-url=~A"
- (encode-urlencoded (format nil "~A?action=save&" (hunchentoot:request-uri*))))
+ (encode-urlencoded (format nil "~A?action=save&~:[~;published=on~]"
+ (hunchentoot:request-uri*)
+ (poi-published poi))))
"[choose]")))))
(:tr (:td "icon")
(:td (icon-chooser "icon" (poi-icon poi))))
@@ -104,8 +109,10 @@
(:tr
(loop for image in (poi-sat-images poi)
for index upfrom 0
- do (html (:td ((:a :href (format nil "/edit-poi-medium/~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)))))
+ do (html (:td ((:a :href (format nil "/edit-poi-medium/~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 (zerop index)
(html ((:img :src "/images/trans.gif" :width "16")))
@@ -124,41 +131,46 @@
:br
(cmslink (format nil "edit-poi-medium/?poi=~A" (store-object-id poi)) "[new]")))))
(:tr (:td (submit-button "save" "save")
- (submit-button "delete" "delete" :confirm "Really delete the POI?"))))
- ;; ;;;;;;;;;;;;;;;;
- (:h2 "Upload new medium")
- ((:form :method "post" :action "/edit-poi-medium" :enctype "multipart/form-data")
- (:table (:tr (:td "Type")
- (:td (select-box "medium-type" (mapcar #'(lambda (class-name) (string-downcase (symbol-name class-name)))
- (class-subclasses (find-class 'poi-medium)))
- :default "poi-image")))
- (:tr
- (:td "File")
- (:td ((:input :type "file" :name "image-file")))
- (:tr ((:td :colspan "2") (submit-button "upload" "upload"))))))
- (:h2 "Attached POI media")
- ((: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")))))))))))))
+ (submit-button "delete" "delete" :confirm "Really delete the POI?")))))
+ (:h2 "Upload new medium")
+ ((:form :method "post" :action "/edit-poi-medium" :enctype "multipart/form-data")
+ (:table
+ ((:input :type "hidden" :name "poi" :value (store-object-id poi)))
+ (:tr (:td "Type")
+ (:td (select-box "new-medium-type" (mapcar #'(lambda (class-name) (string-downcase class-name))
+ (class-subclasses (find-class 'poi-medium)))
+ :default "poi-image")))
+ (:tr
+ (:td "File")
+ (:td ((:input :type "file" :name "image-file")))
+ (:tr ((:td :colspan "2") (submit-button "upload" "upload"))))))
+ (:h2 "Attached POI media")
+ ((: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"))))))))))))
(defmethod handle-object-form ((handler edit-poi-handler)
(action (eql :save)) (poi poi))
- (with-query-params (published title subtitle description language x y icon movie)
+ (with-query-params ((published nil boolean)
+ title subtitle description language
+ (x nil integer)
+ (y nil integer)
+ icon)
+ (prin1 (list :published published :title title :subtitle subtitle :x x :y y :icon icon))
(unless language (setq language (request-language)))
- (let ((args (list :title title
- :published published
- :subtitle subtitle
- :description description
- :icon icon)))
- (when (and x y)
- (setq args (append args (list :area (list (parse-integer x) (parse-integer y))))))
- (when movie
- (setq args (append args (list :movies (list movie)))))
- (apply #'update-poi poi language args))
+ (update-textual-attributes poi language
+ :title title
+ :subtitle subtitle
+ :description description)
+ (update-poi poi
+ :published published
+ :area (when (and x y) (list x y))
+ :icon icon)
(with-bos-cms-page (:title "POI has been updated")
(html (:h2 "Your changes have been saved")
"You may " (cmslink (edit-object-url poi) "continue editing the POI") "."))))
@@ -333,26 +345,24 @@
"You may " (cmslink (edit-object-url poi) "continue editing the POI"))))
(defmethod handle-object-form ((handler edit-poi-medium-handler) (action (eql :upload)) medium)
- (with-query-params (poi)
- (setq poi (find-store-object (parse-integer poi) :class 'poi))
+ (with-query-params ((poi nil integer)
+ new-medium-type)
+ (setq poi (find-store-object poi :class 'poi))
(let ((upload (request-uploaded-file "image-file")))
(unless upload
(error "no file uploaded in upload handler"))
(bknr.web:with-image-from-upload* (upload)
(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)))
+ (eql (cl-gd:image-height) *poi-image-height*))
+ (error "Invalid image size. The image needs to be ~D pixels wide and ~D pixels high. Your uploaded ~
+ image is ~D pixels wide and ~D pixels high. Please use an image editor to resize the image ~
+ and upload it again."
+ *poi-image-width* *poi-image-height*
+ (cl-gd:image-width) (cl-gd:image-height))))
(let ((new-medium (import-image upload
- :class-name (type-of medium)
+ :class-name (if medium
+ (type-of medium)
+ (intern (string-upcase new-medium-type)))
:initargs `(:poi ,poi))))
(when medium
(delete-object medium))
More information about the Bknr-cvs
mailing list