[bknr-cvs] ksprotte changed trunk/projects/bos/
BKNR Commits
bknr at bknr.net
Mon Sep 1 13:11:09 UTC 2008
Revision: 3759
Author: ksprotte
URL: http://bknr.net/trac/changeset/3759
Improved POI-medium edit handler.
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-01 11:22:08 UTC (rev 3758)
+++ trunk/projects/bos/m2/packages.lisp 2008-09-01 13:11:09 UTC (rev 3759)
@@ -207,6 +207,7 @@
;; pois
#:title #:subtitle #:description ; for slot-string access
#:update-textual-attributes
+ #:very-shallow-copy-textual-attributes
#:poi-medium
#:poi-medium-poi
#:make-poi-medium
Modified: trunk/projects/bos/m2/poi.lisp
===================================================================
--- trunk/projects/bos/m2/poi.lisp 2008-09-01 11:22:08 UTC (rev 3758)
+++ trunk/projects/bos/m2/poi.lisp 2008-09-01 13:11:09 UTC (rev 3759)
@@ -32,6 +32,15 @@
(setf (slot-string obj 'description language) description))
obj)
+(deftransaction very-shallow-copy-textual-attributes (from to)
+ "Useful for making the TEXTUAL-ATTRIBUTES of FROM available to TO,
+before FROM is deleted. Please note that copying is so shallow that
+FROM and TO must not both continue to exist."
+ (setf (slot-value to 'title) (slot-value from 'title)
+ (slot-value to 'subtitle) (slot-value from 'subtitle)
+ (slot-value to 'description) (slot-value from 'description))
+ to)
+
;;; poi-medium
(defpersistent-class poi-medium (textual-attributes-mixin)
((poi :reader poi-medium-poi :initarg :poi)))
@@ -157,7 +166,7 @@
;;; Provides for the shifting of images in the edit-poi handler.
;;; Exchanges (nth index (poi-sat-images poi)) with
;;; (nth (1+ index) (poi-sat-images poi)).
-(deftransaction poi-sat-images-exchange-neighbours (poi index)
+(deftransaction poi-sat-images-exchange-neighbours (poi index)
(check-type index (mod 6))
(multiple-value-bind (images positions)
(poi-images poi)
@@ -248,4 +257,3 @@
(warn "~s has a url of ~s" movie (poi-movie-url movie))))))
(mapc #'poi-sanity-check (class-instances 'poi))
(values)))
-
Modified: trunk/projects/bos/web/poi-handlers.lisp
===================================================================
--- trunk/projects/bos/web/poi-handlers.lisp 2008-09-01 11:22:08 UTC (rev 3758)
+++ trunk/projects/bos/web/poi-handlers.lisp 2008-09-01 13:11:09 UTC (rev 3759)
@@ -130,8 +130,7 @@
((:img :border "0" :src "/images/pfeil-r.gif"))))))))))
(unless (= 6 (length (poi-sat-images poi)))
(html
- :br
- (cmslink (format nil "edit-poi-medium/?poi=~A" (store-object-id poi)) "[new]")))))
+ (:p "You may add to these by uploading a new medium of type 'poi-image' below.")))))
(:tr (:td (submit-button "save" "save")
(submit-button "delete" "delete" :confirm "Really delete the POI?")))))
(:h2 "Upload new medium")
@@ -274,20 +273,22 @@
(defmethod handle-object-form ((handler edit-poi-medium-handler) action (medium poi-medium))
(with-query-params (language poi)
+ (assert poi nil "POI id should have been given as a GET param")
(unless language (setq language (request-language)))
(with-bos-cms-page (:title (format nil "Edit ~A" (medium-pretty-type-string medium)))
(html
(cmslink (edit-object-url (poi-medium-poi medium)) "Back to POI")
(content-language-chooser)
- ((:form :method "post" :enctype "multipart/form-data")
- ((:input :type "hidden" :name "poi" :value poi))
- (:table (medium-handler-preview medium)
- (:tr ((:td :colspan "2" :height "10")))
+ (:table (medium-handler-preview medium)
+ (:tr ((:td :colspan "2" :height "10")))
+ ((:form :method "post" :enctype "multipart/form-data")
+ ((:input :type "hidden" :name "poi" :value poi))
(:tr (:td "upload new image")
(:td ((:input :type "file" :name "image-file"))
:br
- (submit-button "upload" "upload")))
- (:tr ((:td :colspan "2" :height "10")))
+ (submit-button "upload" "upload"))))
+ (:tr ((:td :colspan "2" :height "10")))
+ ((:form :method "post")
(:tr (:td "title")
(:td (text-field "title"
:value (slot-string medium 'title language))))
@@ -327,7 +328,7 @@
(:td ((:img :src (format nil "/image/~A/thumbnail,,500,100" (store-object-id medium)))))))))
(defmethod handle-object-form ((handler edit-poi-medium-handler) (action (eql :save)) (medium poi-medium))
- (with-query-params (title subtitle description language)
+ (with-query-params (title subtitle description language poi)
(unless language (setq language (request-language)))
(update-textual-attributes medium language
:title title
@@ -336,7 +337,8 @@
(let ((type-string (medium-pretty-type-string medium)))
(with-bos-cms-page (:title (format nil "~A has been updated" type-string))
(:h2 (format nil "The ~A information has been updated" type-string))
- "You may " (cmslink (format nil "~A?language=~A" (edit-object-url medium) language)
+ "You may " (cmslink (format nil "~A?language=~A&poi=~A"
+ (edit-object-url medium) language poi)
(: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))
@@ -368,6 +370,7 @@
(intern (string-upcase new-medium-type)))
:initargs `(:poi ,poi))))
(when medium
+ (very-shallow-copy-textual-attributes medium new-medium)
(delete-object medium))
(redirect (format nil "/edit-poi-medium/~D?poi=~D"
(store-object-id new-medium)
More information about the Bknr-cvs
mailing list