bknr-cvs

bknr-cvs@common-lisp.net

1964 discussions

[bknr-cvs] hans changed trunk/projects/quickhoney/
by BKNR Commits 07 Sep '08

07 Sep '08

Revision: 3830 Author: hans URL: http://bknr.net/trac/changeset/3830 News permalink and cms functionality updates. Always scale images uploaded down to the right width. U trunk/projects/quickhoney/src/handlers.lisp U trunk/projects/quickhoney/src/webserver.lisp U trunk/projects/quickhoney/upgrade-stuff/import.lisp U trunk/projects/quickhoney/website/static/index.css U trunk/projects/quickhoney/website/static/javascript.js U trunk/projects/quickhoney/website/templates/index.xml Modified: trunk/projects/quickhoney/src/handlers.lisp =================================================================== --- trunk/projects/quickhoney/src/handlers.lisp 2008-09-07 10:24:06 UTC (rev 3829) +++ trunk/projects/quickhoney/src/handlers.lisp 2008-09-07 14:49:19 UTC (rev 3830) @@ -38,25 +38,18 @@ (blob-to-stream (quickhoney-animation-image-animation animation) (send-headers))))) -(defclass json-image-query-handler (object-handler quickhoney-image-handler) - ()) +(defclass json-image-info-handler (object-handler quickhoney-image-handler) + () + (:default-initargs :query-function #'store-image-with-name)) -(defparameter *editable-keywords* '(:explicit :buy-file :buy-print :buy-t-shirt) - "List of keywords that are image keywords which can be edited through the CMS") - -(defun images-in-category-sorted-by-time (cat-sub) - (sort (copy-list (images-in-category cat-sub)) - #'> :key #'blob-timestamp)) - -(defmethod object-handler-get-object ((handler json-image-query-handler)) - (images-in-category-sorted-by-time (mapcar #'make-keyword-from-string (decoded-handler-path handler)))) - (defmethod image-to-json ((image quickhoney-image)) (with-json-object () + (encode-object-element "class" (string-downcase (cl-ppcre:regex-replace "^QUICKHONEY-" (symbol-name (class-name (class-of image))) ""))) (encode-object-element "name" (store-image-name image)) - (encode-object-element "category" (quickhoney-image-category image)) - (when (quickhoney-image-subcategory image) - (encode-object-element "subcategory" (quickhoney-image-subcategory image))) + (when (quickhoney-image-category image) + (encode-object-element "category" (quickhoney-image-category image)) + (when (quickhoney-image-subcategory image) + (encode-object-element "subcategory" (quickhoney-image-subcategory image)))) (encode-object-element "id" (store-object-id image)) (encode-object-element "type" (image-content-type (blob-mime-type image))) (encode-object-element "width" (store-image-width image)) @@ -71,6 +64,24 @@ (dolist (keyword (intersection *editable-keywords* (store-image-keywords image))) (encode-object-element (string-downcase (symbol-name keyword)) t)))))) +(defmethod handle-object ((handler json-image-info-handler) image) + (with-json-response () + (with-object-element ("image") + (image-to-json image)))) + +(defclass json-image-query-handler (object-handler quickhoney-image-handler) + ()) + +(defparameter *editable-keywords* '(:explicit :buy-file :buy-print :buy-t-shirt) + "List of keywords that are image keywords which can be edited through the CMS") + +(defun images-in-category-sorted-by-time (cat-sub) + (sort (copy-list (images-in-category cat-sub)) + #'> :key #'blob-timestamp)) + +(defmethod object-handler-get-object ((handler json-image-query-handler)) + (images-in-category-sorted-by-time (mapcar #'make-keyword-from-string (decoded-handler-path handler)))) + (defmethod layout-to-json ((layout layout)) (with-json-array () (dolist (page (layout-pages layout)) @@ -252,6 +263,17 @@ (defclass upload-image-handler (admin-only-handler prefix-handler) ()) +(defun count-colors-used (&optional (image cl-gd:*default-image*)) + (let ((color-table (make-hash-table :test #'eql))) + (cl-gd:do-pixels (image) + (setf (gethash (cl-gd:raw-pixel) color-table) t)) + (hash-table-count color-table))) + +(defun maybe-convert-to-palette (&optional (image cl-gd:*default-image*)) + (when (and (cl-gd:true-color-p image) + (<= (count-colors-used image) 256)) + (cl-gd:true-color-to-palette :image image))) + (defmethod handle ((handler upload-image-handler)) (with-query-params (client spider-keywords) (let ((uploaded-file (request-uploaded-file "image-file"))) @@ -260,15 +282,10 @@ (unless uploaded-file (error "no file uploaded")) (with-image-from-upload* (uploaded-file) - (let* ((color-table (make-hash-table :test #'eql)) - (width (cl-gd:image-width)) + (let* ((width (cl-gd:image-width)) (height (cl-gd:image-height)) (ratio (/ 1 (max (/ width 300) (/ height 200))))) - (cl-gd:do-pixels () - (incf (gethash (cl-gd:raw-pixel) color-table 0))) - (when (and (cl-gd:true-color-p) - (<= (hash-table-count color-table) 256)) - (cl-gd:true-color-to-palette)) + (maybe-convert-to-palette) (let* ((image (make-store-image :name (pathname-name (upload-original-filename uploaded-file)) :class-name 'quickhoney-image :keywords (cons :upload (image-keywords-from-request-parameters)) @@ -283,8 +300,7 @@ ((:script :type "text/javascript" :language "JavaScript") "function done() { window.opener.do_query(); window.close(); }")) (:body - (:p "Image " (:princ-safe (store-image-name image)) " with " - (:princ-safe (hash-table-count color-table)) " colors uploaded") + (:p "Image " (:princ-safe (store-image-name image)) " uploaded") (:p ((:img :src (format nil "/image/~D" (store-object-id image)) :width (round (* ratio width)) :height (round (* ratio height))))) (:p ((:a :href "javascript:done()") "ok"))))))))))) @@ -303,6 +319,12 @@ (defclass upload-news-handler (admin-only-handler page-handler) ()) +(defun normalize-news-title (title) + (string-downcase (cl-ppcre:regex-replace-all "(?i)[^a-z0-9_]+" title "_"))) + +(defconstant +news-image-width+ 486 + "Width of a news image. Uploaded images that are wider are scaled down.") + (defmethod handle ((handler upload-news-handler)) (with-query-params (title text) (let ((uploaded-file (request-uploaded-file "image-file"))) @@ -310,35 +332,39 @@ (progn (unless uploaded-file (error "no file uploaded")) - (with-image-from-upload* (uploaded-file) - (let* ((color-table (make-hash-table :test #'eql)) - (width (cl-gd:image-width)) - (height (cl-gd:image-height)) - (ratio (/ 1 (max (/ width 300) (/ height 200))))) - (cl-gd:do-pixels () - (incf (gethash (cl-gd:raw-pixel) color-table 0))) - (when (and (cl-gd:true-color-p) - (<= (hash-table-count color-table) 256)) - (cl-gd:true-color-to-palette)) - (let* ((image (make-store-image :name (pathname-name (upload-original-filename uploaded-file)) - :class-name 'quickhoney-news-item - :keywords (list :upload) - :initargs (list :cat-sub (list :news) - :title title - :text text)))) - (with-http-response () - (with-http-body () - (html (:html - (:head - (:title "Upload successful") - ((:script :type "text/javascript" :language "JavaScript") - "function done() { window.opener.do_query(); window.close(); }")) - (:body - (:p "Image " (:princ-safe (store-image-name image)) " with " - (:princ-safe (hash-table-count color-table)) " colors uploaded") - (:p ((:img :src (format nil "/image/~D" (store-object-id image)) - :width (round (* ratio width)) :height (round (* ratio height))))) - (:p ((:a :href "javascript:done()") "ok"))))))))))) + (with-image-from-upload (uploaded-image uploaded-file) + (maybe-convert-to-palette uploaded-image) + (when (> (cl-gd:image-width uploaded-image) +news-image-width+) + (let* ((scaled-height (floor (* (/ +news-image-width+ (cl-gd:image-width uploaded-image)) + (cl-gd:image-height uploaded-image)))) + (scaled-image (cl-gd:create-image +news-image-width+ scaled-height (cl-gd:true-color-p uploaded-image)))) + (cl-gd:copy-image uploaded-image scaled-image + 0 0 0 0 + (cl-gd:image-width uploaded-image) (cl-gd:image-height uploaded-image) + :resample t :resize t + :dest-width +news-image-width+ :dest-height scaled-height) + (cl-gd:destroy-image uploaded-image) + (setf uploaded-image scaled-image))) + (let ((item (make-store-image :name (normalize-news-title title) + :image uploaded-image + :type (if (cl-gd:true-color-p uploaded-image) :jpg :png) + :class-name 'quickhoney-news-item + :keywords (list :upload) + :initargs (list :cat-sub (list :news) + :title title + :text text + :owner (bknr-session-user))))) + (declare (ignore item)) ; for now + (with-http-response () + (with-http-body () + (html (:html + (:head + (:title "News article created") + ((:script :type "text/javascript" :language "JavaScript") + "function done() { window.opener.reload_news(); window.close(); }")) + (:body + (:p "News article created") + (:p ((:a :href "javascript:done()") "ok")))))))))) (error (e) (with-http-response () (with-http-body () @@ -449,17 +475,18 @@ (:p (:princ-safe (apply #'format nil (simple-condition-format-control e) (simple-condition-format-arguments e)))) (:p ((:a :href "javascript:window.close()") "ok")))))))))))) -(defclass rss-channel-handler (object-handler) +(defclass json-news-handler (object-handler) () - (:default-initargs :object-class 'rss-channel :query-function #'find-rss-channel)) + (:default-initargs :query-function (lambda (string) (or (find-rss-channel string) + (store-image-with-name string) + (find-store-object string))))) -(defclass json-news-handler (rss-channel-handler) - ()) - (defgeneric json-encode-news-item (item) (:method ((item t)) ; do nothing ) + (:method :before ((item store-object)) + (encode-object-element "id" (store-object-id item))) (:method :before ((image quickhoney-image)) (when (owned-object-owner image) (encode-object-element "owner" (user-login (owned-object-owner image)))) @@ -480,17 +507,24 @@ (encode-object-element "width" (store-image-width item)) (encode-object-element "height" (store-image-height item)))) -(defmethod handle-object ((handler json-news-handler) (channel rss-channel)) +(defun json-encode-news-items (items) (with-json-response () (with-object-element ("items") (with-json-array () - (dolist (item (rss-channel-items channel)) + (dolist (item items) (with-json-object () (json-encode-news-item item))))))) -(defclass json-news-archive-handler (rss-channel-handler) - ()) +(defmethod handle-object ((handler json-news-handler) (channel rss-channel)) + (json-encode-news-items (rss-channel-items channel))) +(defmethod handle-object ((handler json-news-handler) (item quickhoney-news-item)) + (json-encode-news-items (list item))) + +(defclass json-news-archive-handler (object-handler) + () + (:default-initargs :object-class 'rss-channel :query-function #'find-rss-channel)) + (defmethod handle-object ((handler json-news-archive-handler) (channel rss-channel)) (with-json-response () (with-object-element ("months") Modified: trunk/projects/quickhoney/src/webserver.lisp =================================================================== --- trunk/projects/quickhoney/src/webserver.lisp 2008-09-07 10:24:06 UTC (rev 3829) +++ trunk/projects/quickhoney/src/webserver.lisp 2008-09-07 14:49:19 UTC (rev 3830) @@ -22,6 +22,7 @@ :handler-definitions `(("/random-image" random-image-handler) ("/animation" animation-handler) ("/json-image-query" json-image-query-handler) + ("/json-image-info" json-image-info-handler) ("/json-login" json-login-handler) ("/json-logout" json-logout-handler) ("/json-clients" json-clients-handler) Modified: trunk/projects/quickhoney/upgrade-stuff/import.lisp =================================================================== --- trunk/projects/quickhoney/upgrade-stuff/import.lisp 2008-09-07 10:24:06 UTC (rev 3829) +++ trunk/projects/quickhoney/upgrade-stuff/import.lisp 2008-09-07 14:49:19 UTC (rev 3830) @@ -68,9 +68,7 @@ (with-transaction (:initialize-news) (setf (slot-value (find-rss-channel "quickhoney") 'bknr.rss::items) (sort (remove-if (lambda (image) - (or (member :explicit (store-image-keywords image)) - (not (and (quickhoney-image-category image) - (quickhoney-image-subcategory image))))) + (member :explicit (store-image-keywords image))) (class-instances 'quickhoney-image)) #'> :key #'blob-timestamp))) Modified: trunk/projects/quickhoney/website/static/index.css =================================================================== --- trunk/projects/quickhoney/website/static/index.css 2008-09-07 10:24:06 UTC (rev 3829) +++ trunk/projects/quickhoney/website/static/index.css 2008-09-07 14:49:19 UTC (rev 3830) @@ -359,12 +359,20 @@ } .newsentry h1 { - margin: 5px 0px 2px 0px; + margin: 10px 0px 5px 0px; font-size: 120%; font-weight: normal; color: #30be01 } +.newsentry .delete-button { + margin: 10px 0px 5px 0px; +} + +.newsentry .item-text { + margin-top: 1em; +} + .autonews { height: 106px; color: #000; border-width: 1px; border-style: solid Modified: trunk/projects/quickhoney/website/static/javascript.js =================================================================== --- trunk/projects/quickhoney/website/static/javascript.js 2008-09-07 10:24:06 UTC (rev 3829) +++ trunk/projects/quickhoney/website/static/javascript.js 2008-09-07 14:49:19 UTC (rev 3830) @@ -247,6 +247,18 @@ function make_news_item(item, revealer) { + var delete_button = ''; + + if (logged_in) { + delete_button = BUTTON({ 'class': 'delete-button' }, "Delete"); + delete_button.onclick = function () { + if (confirm('Delete this news article?')) { + loadJSONDoc('/json-edit-image/' + item.id + '?action=delete') + .addCallbacks(reload_news, alert); + } + return false; + } + } return DIV({ 'class': 'newsentry' }, revealer.IMG({ src: "/image/" + encodeURI(item.name) + '/news-article-cutout', style: 'visibility: hidden', @@ -254,9 +266,10 @@ DIV(null, H1(null, item.title), item.date, ' by ', item.owner, ' | ', - A({ href: '#' }, 'permalink'), + A({ href: '#news/' + item.name }, 'permalink'), BR(), - item.text)); + DIV({ 'class': 'item-text' }, item.text), + delete_button)); } function load_news(data) @@ -272,18 +285,21 @@ DIV({ 'class': 'news_sep' }) ]; }, data.items)); $('archive-navigation').style.visibility = 'inherit'; + + display_cms_window(); } catch (e) { log('error displaying news: ' + e); } } -function news(subpath) { - var args = subpath.split('/'); - var year = args[0]; - var month = args[1]; +function reload_news() +{ + $('edit_news_form').reset(); + news(''); +} - log('news year ' + year + ' month ' + month); +function show_news_archive_navigation(year, month) { map(function (element) { ((element.year == year && (month || element.month)) ? addElementClass : removeElementClass) @@ -293,12 +309,33 @@ for (i = 1; i <= 12; i++) { ((month == i) ? addElementClass : removeElementClass)('archive-navigation', 'm' + i); } +} - if (month || !year) { - show_cue('loading news'); +function news(subpath) { + + if (!subpath.match(/^[0-9\/]*$/)) { + + show_cue('loading news item'); $('newsentries').style.visibility = 'hidden'; - loadJSONDoc('/json-news/quickhoney' + (month ? ('?month=' + subpath) : '')) + loadJSONDoc('/json-news/' + subpath) .addCallbacks(load_news, alert); + + } else { + + var args = subpath.split('/'); + var year = args[0]; + var month = args[1]; + + log('news year ' + year + ' month ' + month); + + show_news_archive_navigation(year, month); + + if (month || !year) { + show_cue('loading news'); + $('newsentries').style.visibility = 'hidden'; + loadJSONDoc('/json-news/quickhoney' + (month ? ('?month=' + subpath) : '')) + .addCallbacks(load_news, alert); + } } } @@ -476,7 +513,7 @@ if (logged_in) { if (current_directory == "home") { } else if (current_directory == "news") { - show_cms_window("edit_news_form"); + show_cms_window("edit_news"); } else if (current_directory && current_subdirectory) { if (current_image) { show_cms_window('edit_form'); @@ -1160,7 +1197,7 @@ var url_path = (document.location.href + "#").split("#")[1]; if (url_path && (url_path != document.current_path)) { try { - pageTracker._trackPageview(document.location.href); + pageTracker._trackPageview(document.location.href.replace("#", "/")); } catch (e) { log("tracking failed: " + e); Modified: trunk/projects/quickhoney/website/templates/index.xml =================================================================== --- trunk/projects/quickhoney/website/templates/index.xml 2008-09-07 10:24:06 UTC (rev 3829) +++ trunk/projects/quickhoney/website/templates/index.xml 2008-09-07 14:49:19 UTC (rev 3830) @@ -295,9 +295,9 @@ </form> </div> - <div id="edit_news_form" class="cms_form"> + <div id="edit_news" class="cms_form"> <div class="cms_title">Create news entry</div> - <form action="/upload-news" method="post" + <form action="/upload-news" method="post" id="edit_news_form" enctype="multipart/form-data" target="upload_result" onsubmit="do_upload(this.target);"> <p class="cms"> <table> @@ -321,10 +321,6 @@ <input type="submit" name="action" value="upload" /> </p> </form> - <div class="cms_title">Delete this news entry</div> - <form id="delete_newsentry_form_element" action="/edit-news-js" target="edit_iframe" method="post"> - <input type="submit" name="action" value="delete" onclick="return confirm('Really delete this news entry?');" /> - </form> </div> <div id="saving_edits_form" class="cms_form">

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/payment-website/templates/de/
by BKNR Commits 07 Sep '08

07 Sep '08

Revision: 3829 Author: ksprotte URL: http://bknr.net/trac/changeset/3829 fixed: Frontend: Encoding-Fehler auf impressum-Seite (Fenster schlie?\195?\159en) U trunk/projects/bos/payment-website/templates/de/ring-detail.xml U trunk/projects/bos/payment-website/templates/de/toplevel_extra.xml Modified: trunk/projects/bos/payment-website/templates/de/ring-detail.xml =================================================================== --- trunk/projects/bos/payment-website/templates/de/ring-detail.xml 2008-09-06 20:30:45 UTC (rev 3828) +++ trunk/projects/bos/payment-website/templates/de/ring-detail.xml 2008-09-07 10:24:06 UTC (rev 3829) @@ -21,7 +21,7 @@ <div style="padding:10px"> <img src="/images/pfeil_link_on.gif" width="10" height="9" border="0" alt="" /> <a href="javascript:window.close()" class="more"> - Fenster schlieÃen + Fenster schließen </a> </div> <bos:google-analytics-track /> Modified: trunk/projects/bos/payment-website/templates/de/toplevel_extra.xml =================================================================== --- trunk/projects/bos/payment-website/templates/de/toplevel_extra.xml 2008-09-06 20:30:45 UTC (rev 3828) +++ trunk/projects/bos/payment-website/templates/de/toplevel_extra.xml 2008-09-07 10:24:06 UTC (rev 3829) @@ -25,7 +25,7 @@ <div style="padding:10px"> <img src="/images/pfeil_link_on.gif" width="10" height="9" border="0" alt="" /> <a href="javascript:window.close()" class="more"> - Fenster schlieÃen + Fenster schließen </a> </div> <bos:google-analytics-track />

1 0

[bknr-cvs] hans changed trunk/thirdparty/slime/swank-backend.lisp
by BKNR Commits 06 Sep '08

06 Sep '08

Revision: 3828 Author: hans URL: http://bknr.net/trac/changeset/3828 commit fix to ccl swank U trunk/thirdparty/slime/swank-backend.lisp Modified: trunk/thirdparty/slime/swank-backend.lisp =================================================================== --- trunk/thirdparty/slime/swank-backend.lisp 2008-09-06 20:22:42 UTC (rev 3827) +++ trunk/thirdparty/slime/swank-backend.lisp 2008-09-06 20:30:45 UTC (rev 3828) @@ -213,7 +213,7 @@ :stream-read-char :stream-peek-char :stream-read-line - :stream-file-position + #-openmcl :stream-file-position :stream-listen :stream-unread-char :stream-clear-input

1 0

[bknr-cvs] hans changed trunk/projects/quickhoney/website/
by BKNR Commits 06 Sep '08

06 Sep '08

Revision: 3827 Author: hans URL: http://bknr.net/trac/changeset/3827 Frontpage tweaks A trunk/projects/quickhoney/website/static/frontpage.css U trunk/projects/quickhoney/website/static/index.css U trunk/projects/quickhoney/website/templates/frontpage.xml Added: trunk/projects/quickhoney/website/static/frontpage.css =================================================================== --- trunk/projects/quickhoney/website/static/frontpage.css (rev 0) +++ trunk/projects/quickhoney/website/static/frontpage.css 2008-09-06 20:22:42 UTC (rev 3827) @@ -0,0 +1,14 @@ +#logo { + position: absolute; + right: 10px; + top: 10px; + z-index: 2; +} + +#frontpage p { + margin: 1em; +} +#frontpage div p { + margin: 2em; +} + Modified: trunk/projects/quickhoney/website/static/index.css =================================================================== --- trunk/projects/quickhoney/website/static/index.css 2008-09-06 20:10:47 UTC (rev 3826) +++ trunk/projects/quickhoney/website/static/index.css 2008-09-06 20:22:42 UTC (rev 3827) @@ -465,13 +465,6 @@ font-size: 110%; } -#frontpage p { - margin: 1em; -} -#frontpage div p { - margin: 2em; -} - #overlay { position: absolute; z-index: 100; Modified: trunk/projects/quickhoney/website/templates/frontpage.xml =================================================================== --- trunk/projects/quickhoney/website/templates/frontpage.xml 2008-09-06 20:10:47 UTC (rev 3826) +++ trunk/projects/quickhoney/website/templates/frontpage.xml 2008-09-06 20:22:42 UTC (rev 3827) @@ -10,6 +10,7 @@ <head> <link rel="stylesheet" href="/static/yui/reset-fonts/reset-fonts.css" /> <link rel="stylesheet" href="/static/quickhoney.css" /> + <link rel="stylesheet" href="/static/frontpage.css" /> <link rel="alternate" type="application/rss+xml" title="RSS Feed" href="/rss/quickhoney" /> <script src="/static/javascript.js" type="text/javascript"> </script> @@ -18,7 +19,7 @@ <body id="frontpage"> <p> - <img src="/image/quickhoney" id="the_logo" name="logo" border="0" width="438" height="66" /> + <img src="/image/quickhoney-black" id="logo" border="0" width="442" height="70" /> </p> <div> <h1>QuickHoney Illustrations</h1>

1 0

[bknr-cvs] hans changed trunk/projects/quickhoney/website/static/javascript.js
by BKNR Commits 06 Sep '08

06 Sep '08

Revision: 3826 Author: hans URL: http://bknr.net/trac/changeset/3826 Use correct try/catch syntax U trunk/projects/quickhoney/website/static/javascript.js Modified: trunk/projects/quickhoney/website/static/javascript.js =================================================================== --- trunk/projects/quickhoney/website/static/javascript.js 2008-09-06 20:05:05 UTC (rev 3825) +++ trunk/projects/quickhoney/website/static/javascript.js 2008-09-06 20:10:47 UTC (rev 3826) @@ -1162,7 +1162,7 @@ try { pageTracker._trackPageview(document.location.href); } - error (e) { + catch (e) { log("tracking failed: " + e); } jump_to(url_path);

1 0

[bknr-cvs] hans changed trunk/projects/quickhoney/website/static/javascript.js
by BKNR Commits 06 Sep '08

06 Sep '08

Revision: 3825 Author: hans URL: http://bknr.net/trac/changeset/3825 Track internal URLs with GA. U trunk/projects/quickhoney/website/static/javascript.js Modified: trunk/projects/quickhoney/website/static/javascript.js =================================================================== --- trunk/projects/quickhoney/website/static/javascript.js 2008-09-06 19:56:47 UTC (rev 3824) +++ trunk/projects/quickhoney/website/static/javascript.js 2008-09-06 20:05:05 UTC (rev 3825) @@ -1159,6 +1159,12 @@ function poll_path() { var url_path = (document.location.href + "#").split("#")[1]; if (url_path && (url_path != document.current_path)) { + try { + pageTracker._trackPageview(document.location.href); + } + error (e) { + log("tracking failed: " + e); + } jump_to(url_path); }

1 0

[bknr-cvs] hans changed trunk/projects/quickhoney/website/templates/
by BKNR Commits 06 Sep '08

06 Sep '08

Revision: 3824 Author: hans URL: http://bknr.net/trac/changeset/3824 Add GA tracking. U trunk/projects/quickhoney/website/templates/frontpage.xml U trunk/projects/quickhoney/website/templates/image-browse.xml U trunk/projects/quickhoney/website/templates/index.xml Modified: trunk/projects/quickhoney/website/templates/frontpage.xml =================================================================== --- trunk/projects/quickhoney/website/templates/frontpage.xml 2008-09-06 16:38:25 UTC (rev 3823) +++ trunk/projects/quickhoney/website/templates/frontpage.xml 2008-09-06 19:56:47 UTC (rev 3824) @@ -1,38 +1,47 @@ <?xml version="1.0" encoding="UTF-8"?> <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" - "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> + "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> <html - xmlns:xml="http://www.w3.org/XML/1998/namespace" - xmlns="http://www.w3.org/1999/xhtml" - xmlns:bknr="http://bknr.net" - xmlns:quickhoney="http://quickhoney.com/" - > - <head> - <link rel="stylesheet" href="/static/styles.css" /> - <link rel="alternate" type="application/rss+xml" title="RSS Feed" href="/rss/quickhoney" /> - <script src="/static/javascript.js" type="text/javascript"> - </script> - <title>QuickHoney - Nana Rausch + Peter Stemmler</title> - </head> + xmlns:xml="http://www.w3.org/XML/1998/namespace" + xmlns="http://www.w3.org/1999/xhtml" + xmlns:bknr="http://bknr.net" + xmlns:quickhoney="http://quickhoney.com/" + > + <head> + <link rel="stylesheet" href="/static/yui/reset-fonts/reset-fonts.css" /> + <link rel="stylesheet" href="/static/quickhoney.css" /> + <link rel="alternate" type="application/rss+xml" title="RSS Feed" href="/rss/quickhoney" /> + <script src="/static/javascript.js" type="text/javascript"> + </script> + <title>QuickHoney - Nana Rausch + Peter Stemmler</title> + </head> - <body id="frontpage"> - <p> - <img src="/image/quickhoney" id="the_logo" name="logo" border="0" width="438" height="66" /> - </p> - <div> - <h1>QuickHoney Illustrations</h1> - <p>Studio for Illustration, New York</p> - <h1>Peter Stemmler</h1> - <p>Phone: 646.270.5562<br/>Email: p(a)quickhoney.com</p> - <h1>Nana Rausch</h1> - <p>Phone 646.270.5592<br/>Email: n(a)quickhoney.com</p> - </div> - <p> - This site requires Firefox, Safari or Internet Explorer and Javascript for full viewing pleasure. - </p> - <p>Enter our <a href="/image-browse">Image gallery</a> for basic view.</p> - <script type="text/javascript"> - document.location.href = '/index'; - </script> - </body> + <body id="frontpage"> + <p> + <img src="/image/quickhoney" id="the_logo" name="logo" border="0" width="438" height="66" /> + </p> + <div> + <h1>QuickHoney Illustrations</h1> + <p>Studio for Illustration, New York</p> + <h1>Peter Stemmler</h1> + <p>Phone: 646.270.5562<br/>Email: p(a)quickhoney.com</p> + <h1>Nana Rausch</h1> + <p>Phone 646.270.5592<br/>Email: n(a)quickhoney.com</p> + </div> + <p> + This site requires Firefox, Safari or Internet Explorer and Javascript for full viewing pleasure. + </p> + <p>Enter our <a href="/image-browse">Image gallery</a> for basic view.</p> +<script type="text/javascript"> +var gaJsHost = (("https:" == document.location.protocol) ? "https://ssl." : "http://www."); +document.write(unescape("%3Cscript src='" + gaJsHost + "google-analytics.com/ga.js' type='text/javascript'%3E%3C/script%3E")); +</script> +<script type="text/javascript"> +var pageTracker = _gat._getTracker("UA-3432041-4"); +pageTracker._trackPageview(); +</script> + <script type="text/javascript"> + document.location.href = '/index'; + </script> + </body> </html> Modified: trunk/projects/quickhoney/website/templates/image-browse.xml =================================================================== --- trunk/projects/quickhoney/website/templates/image-browse.xml 2008-09-06 16:38:25 UTC (rev 3823) +++ trunk/projects/quickhoney/website/templates/image-browse.xml 2008-09-06 19:56:47 UTC (rev 3824) @@ -18,6 +18,14 @@ <div id="logo"> <img src="/image/quickhoney-black" id="the_logo" name="logo" border="0" /> </div> +<script type="text/javascript"> +var gaJsHost = (("https:" == document.location.protocol) ? "https://ssl." : "http://www."); +document.write(unescape("%3Cscript src='" + gaJsHost + "google-analytics.com/ga.js' type='text/javascript'%3E%3C/script%3E")); +</script> +<script type="text/javascript"> +var pageTracker = _gat._getTracker("UA-3432041-4"); +pageTracker._trackPageview(); +</script> <quickhoney:simple-image-browser /> <div id="footer"> ©1998-2008 QuickHoney Nana Rausch & Peter Stemmler. No part of Modified: trunk/projects/quickhoney/website/templates/index.xml =================================================================== --- trunk/projects/quickhoney/website/templates/index.xml 2008-09-06 16:38:25 UTC (rev 3823) +++ trunk/projects/quickhoney/website/templates/index.xml 2008-09-06 19:56:47 UTC (rev 3824) @@ -370,6 +370,14 @@ <iframe src="about:blank" height="0" width="0" name="edit_iframe"> </iframe> </div> +<script type="text/javascript"> +var gaJsHost = (("https:" == document.location.protocol) ? "https://ssl." : "http://www."); +document.write(unescape("%3Cscript src='" + gaJsHost + "google-analytics.com/ga.js' type='text/javascript'%3E%3C/script%3E")); +</script> +<script type="text/javascript"> +var pageTracker = _gat._getTracker("UA-3432041-4"); +pageTracker._trackPageview(); +</script> <script language="javascript" type="text/javascript"> init(); </script>

1 0

[bknr-cvs] hans changed trunk/projects/quickhoney/src/
by BKNR Commits 06 Sep '08

06 Sep '08

Revision: 3823 Author: hans URL: http://bknr.net/trac/changeset/3823 Put category and subcategory into slot of quickhoney-image for better performance. U trunk/projects/quickhoney/src/handlers.lisp U trunk/projects/quickhoney/src/image.lisp U trunk/projects/quickhoney/src/money.lisp U trunk/projects/quickhoney/src/news.lisp U trunk/projects/quickhoney/src/quickhoney.asd Modified: trunk/projects/quickhoney/src/handlers.lisp =================================================================== --- trunk/projects/quickhoney/src/handlers.lisp 2008-09-06 16:36:42 UTC (rev 3822) +++ trunk/projects/quickhoney/src/handlers.lisp 2008-09-06 16:38:25 UTC (rev 3823) @@ -24,7 +24,7 @@ ()) (defmethod object-handler-get-object ((handler random-image-handler)) - (random-elt (get-keywords-intersection-store-images (mapcar #'make-keyword-from-string (decoded-handler-path handler))))) + (random-elt (images-in-category (mapcar #'make-keyword-from-string (decoded-handler-path handler))))) (defmethod handle-object ((handler random-image-handler) store-image) (redirect (format nil "/image/~A" (store-object-id store-image)))) @@ -44,14 +44,19 @@ (defparameter *editable-keywords* '(:explicit :buy-file :buy-print :buy-t-shirt) "List of keywords that are image keywords which can be edited through the CMS") +(defun images-in-category-sorted-by-time (cat-sub) + (sort (copy-list (images-in-category cat-sub)) + #'> :key #'blob-timestamp)) + (defmethod object-handler-get-object ((handler json-image-query-handler)) - (sort (remove-if-not (lambda (object) (subtypep (type-of object) 'quickhoney-image)) - (get-keywords-intersection-store-images (mapcar #'make-keyword-from-string (decoded-handler-path handler)))) - #'< :key #'blob-timestamp)) + (images-in-category-sorted-by-time (mapcar #'make-keyword-from-string (decoded-handler-path handler)))) (defmethod image-to-json ((image quickhoney-image)) (with-json-object () (encode-object-element "name" (store-image-name image)) + (encode-object-element "category" (quickhoney-image-category image)) + (when (quickhoney-image-subcategory image) + (encode-object-element "subcategory" (quickhoney-image-subcategory image))) (encode-object-element "id" (store-object-id image)) (encode-object-element "type" (image-content-type (blob-mime-type image))) (encode-object-element "width" (store-image-width image)) @@ -195,28 +200,25 @@ (defclass json-buttons-handler (prefix-handler quickhoney-image-handler) ()) -(defun images-sorted-by-time (&rest keywords) - (sort (remove-if-not (rcurry #'subtypep 'quickhoney-image) - (get-keywords-intersection-store-images keywords) - :key #'type-of) - #'> - :key #'blob-timestamp)) - (defun preproduced-buttons (category subcategory) (let ((images (get-keywords-intersection-store-images (list category subcategory :button)))) (when images (cons :buttons images)))) +(defun images-in-all-subcategories-sorted-by-time (category) + (sort (apply #'append (mapcar (lambda (cat-sub) + (when (eq category (car cat-sub)) + (copy-list (images-in-category cat-sub)))) + (all-categories))) + #'> :key #'blob-timestamp)) + (defun newest-images (category subcategory) - (let ((images (apply #'images-sorted-by-time - (append (unless (eq :home category) - (list category)) - (unless (eq :browseall subcategory) - (list subcategory)))))) + (let ((images (if (eq :home category) + (images-in-all-subcategories-sorted-by-time subcategory) + (images-in-category-sorted-by-time (list category subcategory))))) (when images (cons :images images)))) - (defmethod handle ((handler json-buttons-handler)) (with-json-response () (with-object-element ("buttons") @@ -252,9 +254,7 @@ (defmethod handle ((handler upload-image-handler)) (with-query-params (client spider-keywords) - (let ((uploaded-file (request-uploaded-file "image-file")) - (keywords (append (mapcar #'make-keyword-from-string (decoded-handler-path handler)) - (image-keywords-from-request-parameters)))) + (let ((uploaded-file (request-uploaded-file "image-file"))) (handler-case (progn (unless uploaded-file @@ -271,8 +271,9 @@ (cl-gd:true-color-to-palette)) (let* ((image (make-store-image :name (pathname-name (upload-original-filename uploaded-file)) :class-name 'quickhoney-image - :keywords (cons :upload keywords) - :initargs (list :client client + :keywords (cons :upload (image-keywords-from-request-parameters)) + :initargs (list :cat-sub (mapcar #'make-keyword-from-string (decoded-handler-path handler)) + :client client :spider-keywords spider-keywords)))) (with-http-response () (with-http-body () @@ -321,8 +322,9 @@ (cl-gd:true-color-to-palette)) (let* ((image (make-store-image :name (pathname-name (upload-original-filename uploaded-file)) :class-name 'quickhoney-news-item - :keywords (list :upload :news) - :initargs (list :title title + :keywords (list :upload) + :initargs (list :cat-sub (list :news) + :title title :text text)))) (with-http-response () (with-http-body () @@ -370,8 +372,10 @@ (image (make-store-image :name (pathname-name (upload-original-filename uploaded-image)) :type (make-keyword-from-string (pathname-type (upload-original-filename uploaded-image))) :class-name 'quickhoney-animation-image - :keywords (list :upload :pixel :animation) - :initargs `(:client ,client :animation ,animation-blob)))) + :keywords (list :upload) + :initargs (list :cat-sub (list :pixel :animation) + :client client + :animation animation-blob)))) (with-http-response () (with-http-body () (html (:html @@ -418,9 +422,9 @@ (let* ((image (make-store-image :name (pathname-name (upload-original-filename uploaded-file)) :type (make-keyword-from-string (pathname-type (upload-original-filename uploaded-file))) :class-name 'store-image - :keywords (list :button - (make-keyword-from-string directory) - (make-keyword-from-string subdirectory))))) + :keywords (list :button) + :initargs (list :cat-sub (list (make-keyword-from-string directory) + (make-keyword-from-string subdirectory)))))) (with-http-response () (with-http-body () (html (:html @@ -463,6 +467,8 @@ (encode-object-element "name" (store-image-name image))) (:method ((image quickhoney-image)) (encode-object-element "type" "upload") + (encode-object-element "category" (quickhoney-image-category image)) + (encode-object-element "subcategory" (quickhoney-image-subcategory image)) (with-object-element ("keywords") (with-json-array () (dolist (keyword (store-image-keywords image)) @@ -490,10 +496,10 @@ (with-object-element ("months") (with-json-array () (dolist (month (sort (rss-channel-archived-months channel) - (lambda (a b) - (if (= (first a) (first b)) - (> (second a) (second b)) - (> (first a) (first b)))))) + (lambda (a b) + (if (= (first a) (first b)) + (> (second a) (second b)) + (> (first a) (first b)))))) (with-json-array () (encode-array-element (first month)) (encode-array-element (second month)))))))) Modified: trunk/projects/quickhoney/src/image.lisp =================================================================== --- trunk/projects/quickhoney/src/image.lisp 2008-09-06 16:36:42 UTC (rev 3822) +++ trunk/projects/quickhoney/src/image.lisp 2008-09-06 16:38:25 UTC (rev 3823) @@ -1,12 +1,22 @@ (in-package :quickhoney) (define-persistent-class quickhoney-image (store-image rss-item) - ((client :update :initform nil - :index-type hash-index :index-initargs (:test #'equal) - :index-reader images-for-client - :index-keys all-clients) - (spider-keywords :update :initform nil) - (products :update :initform nil))) + ((client :update + :initform nil + :index-type hash-index :index-initargs (:test #'equal) + :index-reader images-for-client + :index-keys all-clients) + (cat-sub :update + :initform nil + :index-type hash-index :index-initargs (:test #'equal) + :index-reader images-in-category + :index-keys all-categories + :documentation + "Category this image belongs to, as a list of one or two keywords") + (spider-keywords :update + :initform nil) + (products :update + :initform nil))) (defvar *last-image-upload-timestamp* 0) @@ -23,11 +33,18 @@ (get-keywords-intersection-store-images '(:import)))) (defmethod quickhoney-image-category ((image quickhoney-image)) - (first (intersection (store-image-keywords image) '(:pixel :vector :news :contact)))) + (car (quickhoney-image-cat-sub image))) (defmethod quickhoney-image-subcategory ((image quickhoney-image)) - (first (set-difference (store-image-keywords image) '(:pixel :vector :news :button :contact :published :upload)))) + (cadr (quickhoney-image-cat-sub image))) +(defun subcategories-of (category) + (loop + for cat-sub in (all-categories) + when (and (eq category (car cat-sub)) + (cadr cat-sub)) + collect (cadr cat-sub))) + (defmethod make-image-link ((image quickhoney-image) &key internal) (format nil "~@[~A~]/index#~(~A~@[/~A~]~)/~A" (unless internal Modified: trunk/projects/quickhoney/src/money.lisp =================================================================== --- trunk/projects/quickhoney/src/money.lisp 2008-09-06 16:36:42 UTC (rev 3822) +++ trunk/projects/quickhoney/src/money.lisp 2008-09-06 16:38:25 UTC (rev 3823) @@ -1,4 +1,4 @@ -(in-package :quickhoney) +(in-package :shop) (defclass money () ((currency :initarg :currency Modified: trunk/projects/quickhoney/src/news.lisp =================================================================== --- trunk/projects/quickhoney/src/news.lisp 2008-09-06 16:36:42 UTC (rev 3822) +++ trunk/projects/quickhoney/src/news.lisp 2008-09-06 16:38:25 UTC (rev 3823) @@ -7,12 +7,11 @@ (member :explicit (store-image-keywords image))) (defmethod rss-item-encoded-content ((image quickhoney-image)) - (let* ((category (first (intersection (store-image-keywords image) '(:vector :pixel)))) - (is-vector (eq category :vector))) + (let ((is-vector (eq (quickhoney-image-category image) :vector))) (with-output-to-string (s) (html-stream s - ((:div :class (format nil "newsentry news_~(~A~)" category)) + ((:div :class (format nil "newsentry news_~(~A~)" (quickhoney-image-category image))) ((:img :src (format nil "http://~A/image/~A" (website-host) (store-object-id image))) Modified: trunk/projects/quickhoney/src/quickhoney.asd =================================================================== --- trunk/projects/quickhoney/src/quickhoney.asd 2008-09-06 16:36:42 UTC (rev 3822) +++ trunk/projects/quickhoney/src/quickhoney.asd 2008-09-06 16:38:25 UTC (rev 3823) @@ -37,4 +37,9 @@ (:file "tags" :depends-on ("image")) (:file "webserver" :depends-on ("handlers")) (:file "daily" :depends-on ("config")) + + (:file "money" :depends-on ("packages")) + (:file "shop" :depends-on ("money")) + (:file "quickhoney-shop" :depends-on ("shop")) + (:file "init" :depends-on ("webserver" "daily"))))

1 0

[bknr-cvs] hans changed trunk/projects/quickhoney/src/
by BKNR Commits 06 Sep '08

06 Sep '08

Revision: 3822 Author: hans URL: http://bknr.net/trac/changeset/3822 Update shopping data structures, not yet a lot to see here. U trunk/projects/quickhoney/src/packages.lisp A trunk/projects/quickhoney/src/quickhoney-shop.lisp U trunk/projects/quickhoney/src/shop.lisp Modified: trunk/projects/quickhoney/src/packages.lisp =================================================================== --- trunk/projects/quickhoney/src/packages.lisp 2008-09-06 16:34:27 UTC (rev 3821) +++ trunk/projects/quickhoney/src/packages.lisp 2008-09-06 16:36:42 UTC (rev 3822) @@ -17,6 +17,12 @@ :quickhoney.config) (:export)) +(defpackage :shop + (:use :cl + :bknr.datastore + :bknr.indices + :bknr.user)) + (defpackage :quickhoney (:use :cl :cl-user @@ -40,7 +46,12 @@ #:quickhoney-image #:quickhoney-image-client #:quickhoney-image-spider-keywords - #:startup)) + #:startup + #:quickhoney-image-category + #:quickhoney-image-subcategory + #:all-categories + #:subcategories-of + #:images-in-category)) (defpackage :quickhoney.tags (:use :cl Added: trunk/projects/quickhoney/src/quickhoney-shop.lisp =================================================================== --- trunk/projects/quickhoney/src/quickhoney-shop.lisp (rev 0) +++ trunk/projects/quickhoney/src/quickhoney-shop.lisp 2008-09-06 16:36:42 UTC (rev 3822) @@ -0,0 +1,12 @@ +(in-package :quickhoney) + +(define-persistent-class quickhoney-product () + ((image + :update + :type (or quickhoney-image null) + :index-type hash-index + :index-reader products-for-image + :documentation + "Image that this product is related to, or nil for standalone products")) + (:documentation + "Mixin class for Quickhoney products, which are usually related to a QUICKHONEY-IMAGE")) \ No newline at end of file Modified: trunk/projects/quickhoney/src/shop.lisp =================================================================== --- trunk/projects/quickhoney/src/shop.lisp 2008-09-06 16:34:27 UTC (rev 3821) +++ trunk/projects/quickhoney/src/shop.lisp 2008-09-06 16:36:42 UTC (rev 3822) @@ -1,4 +1,4 @@ -(in-package :quickhoney) +(in-package :shop) ;; Shopping system. @@ -24,11 +24,18 @@ :type money :documentation "Price of the product, not including any taxes.") - (image + (name :update - :type (or quickhoney-image null) + :type string + :index-type string-unique-index + :index-reader product-with-name :documentation - "Image that this product is related to, or nil for standalone products"))) + "Short name of the product, must be unique, should be identifier") + (description + :update + :type string + :documentation + "Textual description of the product"))) (defgeneric sell (product) (:documentation @@ -47,7 +54,7 @@ address. Once paid, the system makes the product available to the customer for download.")) -(defgeneric stock-count ((product download-product)) +(defmethod stock-count ((product download-product)) nil) (define-persistent-class emailable-product (product) @@ -58,12 +65,13 @@ be supplied by the customer. Once paid, the system sends the order to the store personnel for fulfillment.")) -(defgeneric stock-count ((product download-product)) +(defmethod stock-count ((product emailable-product)) nil) (define-persistent-class mailable-product (product) ((stock-count :update :type integer + :accessor stock-count :documentation "Number of instances of this product that are available to be sold.")) (:documentation

1 0

[bknr-cvs] hans changed trunk/projects/quickhoney/upgrade-stuff/import.lisp
by BKNR Commits 06 Sep '08

06 Sep '08

Revision: 3821 Author: hans URL: http://bknr.net/trac/changeset/3821 Support db upgrade through just loading this file. U trunk/projects/quickhoney/upgrade-stuff/import.lisp Modified: trunk/projects/quickhoney/upgrade-stuff/import.lisp =================================================================== --- trunk/projects/quickhoney/upgrade-stuff/import.lisp 2008-09-06 16:33:40 UTC (rev 3820) +++ trunk/projects/quickhoney/upgrade-stuff/import.lisp 2008-09-06 16:34:27 UTC (rev 3821) @@ -1,17 +1,17 @@ (in-package :quickhoney) -(defun replace-image (pathname) +(defun replace-image (pathname &rest args) (handler-case (let ((old (store-image-with-name (pathname-name pathname)))) (when old (format t "deleting ~A~%" old) (delete-object old)) - (import-image pathname)) + (apply #'import-image pathname args)) (error (e) (format t "~&; error importing ~S: ~A~%" pathname e)))) (dolist (name '(#p"type-news.png" #p"type-pixel.png" #p"type-shop.png" #p"type-vector.png")) - (import-image name :keywords '(:type))) + (replace-image name :keywords '(:type))) (dolist (pathname '(#P"overlay-close.gif" #P"hey.gif" @@ -32,7 +32,7 @@ #P"pixelcontact.gif")) (replace-image pathname)) -(import-image #p"news-sep.gif") +(replace-image #p"news-sep.gif") (with-transaction (:update-shopping) (dolist (image (get-keywords-intersection-store-images '(:photo :shopping))) @@ -41,6 +41,30 @@ (mapc #'delete-object (get-keywords-intersection-store-images '(:upload :home :button))) (mapc #'delete-object (get-keywords-intersection-store-images '(:clients :nicejobs))) +(defparameter *category-keywords* '(:pixel :vector :news :contact)) +(defparameter *other-keywords* '(:published :upload :import :buy-file :buy-t-shirt :buy-print :explicit :hans :bw)) + +(with-transaction (:initialize-cat-sub) + (dolist (image (class-instances 'quickhoney-image)) + (let ((cat (first (intersection (store-image-keywords image) *category-keywords*))) + (sub (first (set-difference (store-image-keywords image) (append *category-keywords* *other-keywords*))))) + (when cat + (setf (quickhoney-image-cat-sub image) + (if sub + (list cat sub) + (list cat)))) + (setf (store-image-keywords image) + (set-difference (store-image-keywords image) (cons (quickhoney-image-subcategory image) + *category-keywords*)))))) + +(with-transaction (:initialize-owner) + (dolist (image (class-instances 'quickhoney-image)) + (setf (owned-object-owner image) + (case (quickhoney-image-category image) + (:vector (find-user "p")) + (:pixel (find-user "n")) + (t (find-user "hans")))))) + (with-transaction (:initialize-news) (setf (slot-value (find-rss-channel "quickhoney") 'bknr.rss::items) (sort (remove-if (lambda (image)

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

bknr-cvs