Revision: 3816 Author: hans URL: http://bknr.net/trac/changeset/3816

Hierarchical HTML browser. This is far too inefficient yet.

U trunk/projects/quickhoney/src/tags.lisp

Modified: trunk/projects/quickhoney/src/tags.lisp =================================================================== --- trunk/projects/quickhoney/src/tags.lisp 2008-09-05 16:18:22 UTC (rev 3815) +++ trunk/projects/quickhoney/src/tags.lisp 2008-09-05 16:25:53 UTC (rev 3816) @@ -10,29 +10,64 @@ :vms-style t :show-time nil))))))

(define-bknr-tag simple-image-browser () - (let* ((image-name (parse-url)) - (image (or (bknr.images:store-image-with-name image-name) - (error #?"image $(image-name) not found")))) - (html - (:table - (:tbody - (:tr (:td "name") (:td (:princ image-name))) - (let ((next (cadr (member image (bknr.datastore:class-instances 'quickhoney-image))))) - (when next - (html (:tr (:td "next") - (:td ((:a :href #?"/image-browse/$((bknr.images:store-image-name next))") - (:princ (bknr.images:store-image-name next)))))))) - (:tr (:td "width") (:td (:princ (bknr.images:store-image-width image)))) - (:tr (:td "height") (:td (:princ (bknr.images:store-image-height image)))) - (when (quickhoney-image-client image) - (html (:tr (:td "client") (:td (:princ (quickhoney-image-client image)))))) - (when (quickhoney-image-spider-keywords image) - (html (:tr (:td "description") (:td (:princ (quickhoney-image-spider-keywords image)))))))) - ((:img :src #?"/image/$(image-name)" - :width (bknr.images:store-image-width image) - :height (bknr.images:store-image-height image))) - ((:script :type "text/javascript") - (:princ #?"document.location.href = document.location.href.replace(/\/image-browse.*/, '$((make-image-link image :internal t))');"))))) + (tbnl:handle-if-modified-since (last-image-upload-timestamp)) + (destructuring-bind (&optional category subcategory image-name) (multiple-value-list (parse-url)) + (cond + (image-name + (let ((image (or (bknr.images:store-image-with-name image-name) + (error #?"image $(image-name) not found")))) + (html + (:table + (:tbody + (:tr (:td "name") (:td (:princ image-name))) + (let ((next (cadr (member image (bknr.datastore:class-instances 'quickhoney-image))))) + (when next + (html (:tr (:td "next") + (:td ((:a :href #?"/image-browse/$((bknr.images:store-image-name next))") + (:princ (bknr.images:store-image-name next)))))))) + (:tr (:td "width") (:td (:princ (bknr.images:store-image-width image)))) + (:tr (:td "height") (:td (:princ (bknr.images:store-image-height image)))) + (when (quickhoney-image-client image) + (html (:tr (:td "client") (:td (:princ (quickhoney-image-client image)))))) + (when (quickhoney-image-spider-keywords image) + (html (:tr (:td "description") (:td (:princ (quickhoney-image-spider-keywords image)))))))) + ((:img :src #?"/image/$(image-name)" + :width (bknr.images:store-image-width image) + :height (bknr.images:store-image-height image))) + ((:script :type "text/javascript") + (:princ #?"document.location.href = document.location.href.replace(/\/image-browse.*/, '$((make-image-link image :internal t))');"))))) + (subcategory + (html + (:h1 (:princ #?"Images with category $(category) and subcategory $(subcategory)")) + (:ul + (dolist (image (bknr.images:get-keywords-intersection-store-images + (mapcar #'make-keyword-from-string (list category subcategory)))) + (html + (:li ((:a :href #?"/image-browse/$(category)/$(subcategory)/$((bknr.images:store-image-name image))") + (:princ (bknr.images:store-image-name image))))))))) + (category + (html + (:h1 (:princ #?"Subcategories of $(category)")) + (:ul + (dolist (subcategory (mapcar #'car + (group-on (remove (find-class 'quickhoney::quickhoney-image) + (bknr.images:get-keyword-store-images (make-keyword-from-string category)) + :test (complement #'eq) :key #'class-of) + :key #'quickhoney::quickhoney-image-subcategory))) + (html + (:li ((:a :href (format nil "/image-browse/~A/~(~A~)" category subcategory))) + (:princ subcategory))))))) + (t + (html + (:h1 (:princ #?"Categories")) + (:ul + (dolist (category (mapcar #'car + (group-on (bknr.datastore:class-instances 'quickhoney::quickhoney-image) + :key #'quickhoney::quickhoney-image-category))) + (when category + (html + (:li ((:a :href (format nil "/image-browse/~(~A~)" category))) + (:princ category)))))))))))

(define-bknr-tag first-image-link () (html @@ -47,4 +82,5 @@ (query-param "__username")) (html (:h1 "Login failed, please try again"))) (t - (html (:h1 "Please login"))))) \ No newline at end of file + (html (:h1 "Please login"))))) +