Changeset 3722 for trunk/projects/bos
- Timestamp:
- 08/01/08 17:43:33 (4 months ago)
- Files:
-
- trunk/projects/bos/m2/packages.lisp (modified) (1 diff)
- trunk/projects/bos/m2/poi.lisp (modified) (1 diff)
- trunk/projects/bos/web/poi-handlers.lisp (modified) (6 diffs)
Legend:
- Unmodified
- Added
- Removed
- Modified
- Copied
- Moved
trunk/projects/bos/m2/packages.lisp
r3706 r3722 225 225 #:poi-media 226 226 #:make-poi 227 #:update-poi 227 228 #:poi-complete 228 229 #:poi-center-x trunk/projects/bos/m2/poi.lisp
r3708 r3722 102 102 (defmethod destroy-object :before ((poi poi)) 103 103 (mapc #'delete-object (poi-media poi))) 104 105 (deftransaction update-poi (poi &key published icon area) 106 (check-type published boolean) 107 (check-type area list) 108 (setf (poi-published poi) published) 109 (when icon 110 (setf (poi-icon poi) icon)) 111 (when area 112 (setf (poi-area poi) area)) 113 poi) 104 114 105 115 (defmethod poi-complete ((poi poi) language) trunk/projects/bos/web/poi-handlers.lisp
r3712 r3722 71 71 (:tr (:td "name") 72 72 (:td (:princ-safe (poi-name poi)) 73 (cmslink (format nil "/poi-xml/~D?lang=~A" (store-object-id poi) language) "view"))) 73 " " 74 (cmslink (format nil "/poi-xml/~D?lang=~A" (store-object-id poi) language) "[view]"))) 74 75 (:tr (:td "published") 75 76 (:td (checkbox-field "published" "published" :checked (poi-published poi)))) … … 91 92 (cmslink (format nil "map-browser/~A/~A?chosen-url=~A" 92 93 (first (poi-area poi)) (second (poi-area poi)) 93 (encode-urlencoded (format nil "~A?action=save&" (hunchentoot:request-uri*)))) 94 (encode-urlencoded (format nil "~A?action=save&~:[~;published=on~]" 95 (hunchentoot:request-uri*) 96 (poi-published poi)))) 94 97 "[relocate]")) 95 98 (t 96 99 (cmslink (format nil "map-browser/?chosen-url=~A" 97 (encode-urlencoded (format nil "~A?action=save&" (hunchentoot:request-uri*)))) 100 (encode-urlencoded (format nil "~A?action=save&~:[~;published=on~]" 101 (hunchentoot:request-uri*) 102 (poi-published poi)))) 98 103 "[choose]"))))) 99 104 (:tr (:td "icon") … … 105 110 (loop for image in (poi-sat-images poi) 106 111 for index upfrom 0 107 do (html (:td ((:a :href (format nil "/edit-poi-medium/~a?poi=~A" (store-object-id image) (store-object-id poi))) 108 ((:img :border "0" :src (format nil "/image/~a/thumbnail,,55,55" (store-object-id image))))) 112 do (html (:td ((:a :href (format nil "/edit-poi-medium/~a?poi=~A" 113 (store-object-id image) (store-object-id poi))) 114 ((:img :border "0" :src (format nil "/image/~a/thumbnail,,55,55" 115 (store-object-id image))))) 109 116 :br 110 117 (if (zerop index) … … 125 132 (cmslink (format nil "edit-poi-medium/?poi=~A" (store-object-id poi)) "[new]"))))) 126 133 (:tr (:td (submit-button "save" "save") 127 (submit-button "delete" "delete" :confirm "Really delete the POI?")))) 128 ;; ;;;;;;;;;;;;;;;; 129 (:h2 "Upload new medium") 130 ((:form :method "post" :action "/edit-poi-medium" :enctype "multipart/form-data") 131 (:table (:tr (:td "Type") 132 (:td (select-box "medium-type" (mapcar #'(lambda (class-name) (string-downcase (symbol-name class-name))) 133 (class-subclasses (find-class 'poi-medium))) 134 :default "poi-image"))) 135 (:tr 136 (:td "File") 137 (:td ((:input :type "file" :name "image-file"))) 138 (:tr ((:td :colspan "2") (submit-button "upload" "upload")))))) 139 (:h2 "Attached POI media") 140 ((:table :border "1") 141 (dolist (medium (poi-media poi)) 142 (html (:tr (:td (:princ-safe (medium-pretty-type-string medium))) 143 (:td (:table (medium-handler-preview medium :small t) 144 (:tr (:td) 145 (:td (cmslink (format nil "/edit-poi-medium/~D?poi=~D" 146 (store-object-id medium) (store-object-id poi)) "edit"))))))))))))) 134 (submit-button "delete" "delete" :confirm "Really delete the POI?"))))) 135 (:h2 "Upload new medium") 136 ((:form :method "post" :action "/edit-poi-medium" :enctype "multipart/form-data") 137 (:table 138 ((:input :type "hidden" :name "poi" :value (store-object-id poi))) 139 (:tr (:td "Type") 140 (:td (select-box "new-medium-type" (mapcar #'(lambda (class-name) (string-downcase class-name)) 141 (class-subclasses (find-class 'poi-medium))) 142 :default "poi-image"))) 143 (:tr 144 (:td "File") 145 (:td ((:input :type "file" :name "image-file"))) 146 (:tr ((:td :colspan "2") (submit-button "upload" "upload")))))) 147 (:h2 "Attached POI media") 148 ((:table :border "1") 149 (dolist (medium (poi-media poi)) 150 (html (:tr (:td (:princ-safe (medium-pretty-type-string medium))) 151 (:td (:table (medium-handler-preview medium :small t) 152 (:tr (:td) 153 (:td (cmslink (format nil "/edit-poi-medium/~D?poi=~D" 154 (store-object-id medium) (store-object-id poi)) 155 "edit")))))))))))) 147 156 148 157 (defmethod handle-object-form ((handler edit-poi-handler) 149 158 (action (eql :save)) (poi poi)) 150 (with-query-params (published title subtitle description language x y icon movie) 159 (with-query-params ((published nil boolean) 160 title subtitle description language 161 (x nil integer) 162 (y nil integer) 163 icon) 164 (prin1 (list :published published :title title :subtitle subtitle :x x :y y :icon icon)) 151 165 (unless language (setq language (request-language))) 152 (let ((args (list :title title 153 :published published 154 :subtitle subtitle 155 :description description 156 :icon icon))) 157 (when (and x y) 158 (setq args (append args (list :area (list (parse-integer x) (parse-integer y)))))) 159 (when movie 160 (setq args (append args (list :movies (list movie))))) 161 (apply #'update-poi poi language args)) 166 (update-textual-attributes poi language 167 :title title 168 :subtitle subtitle 169 :description description) 170 (update-poi poi 171 :published published 172 :area (when (and x y) (list x y)) 173 :icon icon) 162 174 (with-bos-cms-page (:title "POI has been updated") 163 175 (html (:h2 "Your changes have been saved") … … 334 346 335 347 (defmethod handle-object-form ((handler edit-poi-medium-handler) (action (eql :upload)) medium) 336 (with-query-params (poi) 337 (setq poi (find-store-object (parse-integer poi) :class 'poi)) 348 (with-query-params ((poi nil integer) 349 new-medium-type) 350 (setq poi (find-store-object poi :class 'poi)) 338 351 (let ((upload (request-uploaded-file "image-file"))) 339 352 (unless upload … … 341 354 (bknr.web:with-image-from-upload* (upload) 342 355 (unless (and (eql (cl-gd:image-width) *poi-image-width*) 343 (eql (cl-gd:image-height) *poi-image-height*)) 344 (with-bos-cms-page (:title "Invalid image size") 345 (:h2 "Invalid image size") 346 (:p "The image needs to be " 347 (:princ-safe *poi-image-width*) " pixels wide and " 348 (:princ-safe *poi-image-height*) " pixels high. Your uploaded image is " 349 (:princ-safe (cl-gd:image-width)) " pixels wide and " 350 (:princ-safe (cl-gd:image-height)) " pixels high. Please use an image editor " 351 "to resize the image and upload it again.") 352 (:p (cmslink (edit-object-url poi) "Back to POI"))) 353 (return-from handle-object-form t))) 356 (eql (cl-gd:image-height) *poi-image-height*)) 357 (error "Invalid image size. The image needs to be ~D pixels wide and ~D pixels high. Your uploaded ~ 358 image is ~D pixels wide and ~D pixels high. Please use an image editor to resize the image ~ 359 and upload it again." 360 *poi-image-width* *poi-image-height* 361 (cl-gd:image-width) (cl-gd:image-height)))) 354 362 (let ((new-medium (import-image upload 355 :class-name (type-of medium) 363 :class-name (if medium 364 (type-of medium) 365 (intern (string-upcase new-medium-type))) 356 366 :initargs `(:poi ,poi)))) 357 367 (when medium
