[bknr-cvs] ksprotte changed trunk/
BKNR Commits
bknr at bknr.net
Thu Jul 31 16:31:28 UTC 2008
Revision: 3712
Author: ksprotte
URL: http://bknr.net/trac/changeset/3712
xhtmlgen: should have left :canonical nil untouched
U trunk/projects/bos/web/cms-links.lisp
U trunk/projects/bos/web/poi-handlers.lisp
U trunk/projects/bos/web/webserver.lisp
U trunk/xhtmlgen/xhtmlgen.lisp
Modified: trunk/projects/bos/web/cms-links.lisp
===================================================================
--- trunk/projects/bos/web/cms-links.lisp 2008-07-31 16:16:24 UTC (rev 3711)
+++ trunk/projects/bos/web/cms-links.lisp 2008-07-31 16:31:28 UTC (rev 3712)
@@ -29,12 +29,9 @@
(cmslink (edit-object-url poi)
(:princ (format nil "edit ~a" (poi-name poi)))))
-(defmethod object-url ((poi-image poi-image))
- (format nil "/poi-image/~A" (store-object-id poi-image)))
+(defmethod edit-object-url ((medium poi-medium))
+ (format nil "/edit-poi-medium/~a" (store-object-id medium)))
-(defmethod edit-object-url ((poi-image poi-image))
- (format nil "/edit-poi-image/~a" (store-object-id poi-image)))
-
(defmethod html-link ((poi-image poi-image))
(cmslink (object-url poi-image)
(:princ (store-object-id poi-image))))
Modified: trunk/projects/bos/web/poi-handlers.lisp
===================================================================
--- trunk/projects/bos/web/poi-handlers.lisp 2008-07-31 16:16:24 UTC (rev 3711)
+++ trunk/projects/bos/web/poi-handlers.lisp 2008-07-31 16:31:28 UTC (rev 3712)
@@ -64,7 +64,7 @@
(content-language-chooser)
(unless (poi-complete poi language)
(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 one image "
+ "the location and all text fields are set and that at least 6 images "
"has been uploaded.")))
((:form :method "POST" :enctype "multipart/form-data")
((:table :border "1")
@@ -98,13 +98,13 @@
"[choose]")))))
(:tr (:td "icon")
(:td (icon-chooser "icon" (poi-icon poi))))
- (:tr (:td "images")
+ (:tr (:td "sat images")
(:td
((:table)
(:tr
(loop for image in (poi-sat-images poi)
for index upfrom 0
- do (html (:td ((:a :href (format nil "/edit-poi-image/~a?poi=~A" (store-object-id image) (store-object-id poi)))
+ 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)
@@ -119,57 +119,31 @@
(store-object-id poi) index
(store-object-id image)))
((:img :border "0" :src "/images/pfeil-r.gif"))))))))))
- (unless (eql 6 (length (poi-sat-images poi)))
+ (unless (= 6 (length (poi-sat-images poi)))
(html
:br
- (cmslink (format nil "edit-poi-image/?poi=~A" (store-object-id poi)) "[new]")))))
- (:tr (:td "airal view"
- ((:input :id "airal-id" :type "hidden" :name "airal-id")))
- (:td (:table (dolist (airal (poi-airals poi))
- (html (:tr (:td ((:a :href (format nil "/image/~D" (store-object-id airal))
- :target "_new")
- ((:img :src (format nil "/image/~D" (store-object-id airal))
- :width "90" :height "90"))))
- (:td (submit-button "delete-airal" "delete-airal"
- :formcheck #?"javascript:confirm_delete('airal-id', $((store-object-id airal)), 'Really delete the airal?')")))))
- (:tr ((:td :colspan "2")
- "Upload new airal view"
- ((:input :type "file" :name "image-file"))
- :br
- (submit-button "upload-airal" "upload-airal"))))))
- (: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"
- :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"))
- :br
- (submit-button "upload-panorama" "upload-panorama"))))
- (:tr (:td "movies"
- ((:input :id "movie-id" :type "hidden" :name "movie-id")))
- (:td (dolist (movie (poi-movies poi))
- (html (:princ-safe (format-date-time (store-object-last-change movie 0)))
- ((:a :href (format nil "/poi-movie/~D" (store-object-id movie)) :target "_new" :class "cmslink")
- " view ")
- (submit-button "delete-movie" "delete-movie"
- :formcheck #?"javascript:confirm_delete('movie-id', $((store-object-id movie)), 'Really delete this movie?')")
- :br))
- (html "URL or 'embed' string: "
- ((:input :type "text"
- :size "50"
- :name "movie-url"
- :id "movie"
- :value ""
- :onchange "parse_youtube_link(this)"))
- :br
- (submit-button "add-movie" "add-movie"))))
+ (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?"))))))))
+ (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")))))))))))))
(defmethod handle-object-form ((handler edit-poi-handler)
(action (eql :save)) (poi poi))
@@ -278,6 +252,114 @@
(html (:h2 "POI has been deleted")
"The POI has been deleted")))
+
+;;; edit-poi-medium-handler
+(defclass edit-poi-medium-handler (editor-only-handler edit-object-handler)
+ ()
+ (:default-initargs :object-class 'poi-medium))
+
+(defmethod handle-object-form ((handler edit-poi-medium-handler) action (medium poi-medium))
+ (with-query-params (language poi)
+ (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")))
+ (:tr (:td "upload new image")
+ (:td ((:input :type "file" :name "image-file"))
+ :br
+ (submit-button "upload" "upload")))
+ (:tr ((:td :colspan "2" :height "10")))
+ (:tr (:td "title")
+ (:td (text-field "title"
+ :value (slot-string medium 'title language))))
+ (:tr (:td "subtitle")
+ (:td (text-field "subtitle"
+ :value (slot-string medium 'subtitle language))))
+ (:tr (:td "description")
+ (:td (textarea-field "description"
+ :value (slot-string medium 'description language)
+ :rows 5
+ :cols 40)))
+ (:tr (:td (submit-button "save" "save") (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"))
+
+(defgeneric medium-handler-preview (medium &key small)
+ (:method ((medium t) &key small)
+ (declare (ignore small))
+ (html ((:tr :colspan "2") "No preview")))
+ (:method ((medium poi-image) &key small)
+ (html
+ (:tr (:td "thumbnail")
+ (:td ((:img :src (format nil "/image/~A/thumbnail,,55,55" (store-object-id medium))))))
+ (unless small
+ (html
+ (:tr (:td "full image")
+ (:td ((:img :src (format nil "/image/~A" (store-object-id medium))))))))))
+ (:method ((medium poi-panorama) &key small)
+ (declare (ignore small))
+ (html
+ (:tr (:td "thumbnail")
+ (: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)
+ (unless language (setq language (request-language)))
+ (update-textual-attributes medium language
+ :title title
+ :subtitle subtitle
+ :description description)
+ (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)
+ (: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"))))
+
+(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))
+ (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)))
+ (let ((new-medium (import-image upload
+ :class-name (type-of medium)
+ :initargs `(:poi ,poi))))
+ (when medium
+ (delete-object medium))
+ (redirect (format nil "/edit-poi-medium/~D?poi=~D"
+ (store-object-id new-medium)
+ (store-object-id poi)))))))
+
;;; edit-poi-image-handler
(defclass edit-poi-image-handler (editor-only-handler edit-object-handler)
()
Modified: trunk/projects/bos/web/webserver.lisp
===================================================================
--- trunk/projects/bos/web/webserver.lisp 2008-07-31 16:16:24 UTC (rev 3711)
+++ trunk/projects/bos/web/webserver.lisp 2008-07-31 16:31:28 UTC (rev 3712)
@@ -157,6 +157,7 @@
(make-instance 'bos-website
:name "create-rainforest.org CMS"
:handler-definitions `(("/edit-poi-image" edit-poi-image-handler)
+ ("/edit-poi-medium" edit-poi-medium-handler)
("/edit-poi" edit-poi-handler)
("/edit-sponsor" edit-sponsor-handler)
("/kml-upload" kml-upload-handler)
Modified: trunk/xhtmlgen/xhtmlgen.lisp
===================================================================
--- trunk/xhtmlgen/xhtmlgen.lisp 2008-07-31 16:16:24 UTC (rev 3711)
+++ trunk/xhtmlgen/xhtmlgen.lisp 2008-07-31 16:31:28 UTC (rev 3712)
@@ -51,12 +51,12 @@
,(process-html-forms forms env)))
(if (boundp '*html-sink*)
(,body)
- (let ((*html-sink* (cxml:make-character-stream-sink *standard-output* :canonical t)))
+ (let ((*html-sink* (cxml:make-character-stream-sink *standard-output* :canonical nil)))
(,body)
(sax:end-document *html-sink*))))))
(defmacro html-stream (stream &rest forms &environment env)
- `(let ((*html-sink* (cxml:make-character-stream-sink ,stream :canonical t)))
+ `(let ((*html-sink* (cxml:make-character-stream-sink ,stream :canonical nil)))
,(process-html-forms forms env)
(sax:end-document *html-sink*)))
@@ -64,7 +64,7 @@
(declare (ignore indentation))
(when indentation-given
(warn "WITH-XHTML: indentation argument is deprecated. It will be ignored"))
- `(let ((*html-sink* (cxml:make-character-stream-sink ,stream :canonical t)))
+ `(let ((*html-sink* (cxml:make-character-stream-sink ,stream :canonical nil)))
(sax:start-document *html-sink*)
(sax:start-dtd *html-sink*
"html"
More information about the Bknr-cvs
mailing list