September 2008 - bknr-cvs@common-lisp.net

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

17 Sep '08

Revision: 3914 Author: hans URL: http://bknr.net/trac/changeset/3914 Always show same button home page and category. Add 'quickhoney' application to twitter message. Use more images to create buttons on home page. U trunk/projects/quickhoney/src/handlers.lisp U trunk/projects/quickhoney/src/twitter.lisp U trunk/projects/quickhoney/website/static/javascript.js Modified: trunk/projects/quickhoney/src/handlers.lisp =================================================================== --- trunk/projects/quickhoney/src/handlers.lisp 2008-09-17 13:31:04 UTC (rev 3913) +++ trunk/projects/quickhoney/src/handlers.lisp 2008-09-17 20:20:54 UTC (rev 3914) @@ -236,7 +236,12 @@ (images-in-all-subcategories-sorted-by-time subcategory) (images-in-category-sorted-by-time (list category subcategory))))) (when images - (cons :images images)))) + (cons :images (loop with since = (- (get-universal-time) (* 60 60 24 14)) + for i from 0 + for image in images + when (or (< i 10) + (> (blob-timestamp image) since)) + collect image))))) (defmethod handle ((handler json-buttons-handler)) (with-json-response () @@ -256,8 +261,7 @@ ;; format and come with the caption rendered into ;; them. (let ((category (make-keyword-from-string category)) - (subcategory (make-keyword-from-string subcategory)) - (count 10)) + (subcategory (make-keyword-from-string subcategory))) (destructuring-bind (&optional type &rest images) (or (preproduced-buttons category subcategory) (newest-images category subcategory) @@ -265,9 +269,7 @@ (encode-array-element type) (dolist (image (or images (list (store-image-with-name "button-dummy")))) - (encode-array-element (store-object-id image)) - (when (zerop (decf count)) - (return))))))))))))) + (encode-array-element (store-object-id image))))))))))))) (defclass upload-image-handler (admin-only-handler prefix-handler) ()) Modified: trunk/projects/quickhoney/src/twitter.lisp =================================================================== --- trunk/projects/quickhoney/src/twitter.lisp 2008-09-17 13:31:04 UTC (rev 3913) +++ trunk/projects/quickhoney/src/twitter.lisp 2008-09-17 20:20:54 UTC (rev 3914) @@ -19,7 +19,8 @@ (let ((result (babel:octets-to-string (drakma:http-request "http://twitter.com/statuses/update.xml" :method :post - :content (format nil "status=~A" status-string) + :content (format nil "status=~A&source=quickhoney" + (hunchentoot:url-encode status-string)) :content-type "application/x-www-form-urlencoded" :basic-authorization (account-authorization account))))) (when (cl-ppcre:scan "<error>" result) Modified: trunk/projects/quickhoney/website/static/javascript.js =================================================================== --- trunk/projects/quickhoney/website/static/javascript.js 2008-09-17 13:31:04 UTC (rev 3913) +++ trunk/projects/quickhoney/website/static/javascript.js 2008-09-17 20:20:54 UTC (rev 3914) @@ -645,13 +645,28 @@ /* directory - first level category */ var button_images = []; +var last_category_buttons = {}; function random_button_image(category, subcategory, width, height, cut_category) { + + /* We want the last used button for a category used on the home + * page to also appear on that categories page next. For that, we + * save the previously displayed home image button here. Not pretty. + */ + var key = category + '/' + subcategory; var image_ids = button_images[key]; if (image_ids && image_ids.length) { var type = image_ids[0]; - var image_id = image_ids[1 + Math.floor(Math.random() * (image_ids.length - 1))]; + var ids = image_ids.slice(1); + var image_id = ids[Math.floor(Math.random() * ids.length)]; + if (last_category_buttons[category] && findValue(ids, last_category_buttons[category]) != -1) { + image_id = last_category_buttons[category]; + last_category_buttons[category] = null; + } + if (category == 'home') { + last_category_buttons[subcategory] = image_id; + } if (type == 'buttons') { return '/image/' + image_id; } else { @@ -1582,7 +1597,10 @@ TBODY(null, TR(null, TD({ 'class': 't-shirt-sample', valign: 'top' }, - IMG({ id: 't-shirt-sample', src: '/image/' + encodeURI(current_image.name) + '/cell,ffffff,100,100,10'})), + IMG({ id: 't-shirt-sample', + src: ('/image/' + + encodeURI(current_image.name) + + '/cell,ffffff,100,100,10')})), TD(null, "Color:", BR(), "Tee - white", BR(),

1 0

[bknr-cvs] hans changed trunk/projects/quickhoney/src/handlers.lisp
by BKNR Commits 17 Sep '08

17 Sep '08

Revision: 3913 Author: hans URL: http://bknr.net/trac/changeset/3913 Make URLs tiny instead of relying on Twitter to do so, as that won't always work. U trunk/projects/quickhoney/src/handlers.lisp Modified: trunk/projects/quickhoney/src/handlers.lisp =================================================================== --- trunk/projects/quickhoney/src/handlers.lisp 2008-09-17 11:47:43 UTC (rev 3912) +++ trunk/projects/quickhoney/src/handlers.lisp 2008-09-17 13:31:04 UTC (rev 3913) @@ -305,9 +305,13 @@ :spider-keywords spider-keywords)))) (with-http-response () (with-http-body () - (twitter:update-status (bknr-session-user) - (format nil "Uploaded new image ~A: http://quickhoney.com~A/~A" - image-name (handler-path handler) image-name)) + (let ((tinyurl (drakma:http-request + (format nil "http://tinyurl.com/api-create.php?url=~A" + (hunchentoot:url-encode (format nil "http://quickhoney.com~A/~A" + (handler-path handler) image-name)))))) + (twitter:update-status (bknr-session-user) + (format nil "Uploaded new image ~A: ~A" + image-name tinyurl))) (html (:html (:head (:title "Upload successful")

1 0

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

17 Sep '08

Revision: 3912 Author: hans URL: http://bknr.net/trac/changeset/3912 Add automatic Twitter status updates when uploading. Remove upgrade stuff, we're live! U trunk/projects/quickhoney/src/handlers.lisp U trunk/projects/quickhoney/src/packages.lisp U trunk/projects/quickhoney/src/quickhoney.asd U trunk/projects/quickhoney/src/twitter.lisp D trunk/projects/quickhoney/upgrade-stuff/ U trunk/projects/quickhoney/website/static/javascript.js Modified: trunk/projects/quickhoney/src/handlers.lisp =================================================================== --- trunk/projects/quickhoney/src/handlers.lisp 2008-09-17 09:26:32 UTC (rev 3911) +++ trunk/projects/quickhoney/src/handlers.lisp 2008-09-17 11:47:43 UTC (rev 3912) @@ -293,9 +293,10 @@ (with-image-from-upload* (uploaded-file) (let* ((width (cl-gd:image-width)) (height (cl-gd:image-height)) - (ratio (/ 1 (max (/ width 300) (/ height 200))))) + (ratio (/ 1 (max (/ width 300) (/ height 200)))) + (image-name (pathname-name (upload-original-filename uploaded-file)))) (maybe-convert-to-palette) - (let* ((image (make-store-image :name (pathname-name (upload-original-filename uploaded-file)) + (let* ((image (make-store-image :name image-name :class-name 'quickhoney-image :keywords (cons :upload (image-keywords-from-request-parameters)) :initargs (list :owner (bknr-session-user) @@ -304,6 +305,9 @@ :spider-keywords spider-keywords)))) (with-http-response () (with-http-body () + (twitter:update-status (bknr-session-user) + (format nil "Uploaded new image ~A: http://quickhoney.com~A/~A" + image-name (handler-path handler) image-name)) (html (:html (:head (:title "Upload successful") @@ -355,16 +359,19 @@ :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))))) + (let* ((title (normalize-news-title title)) + (item (make-store-image :name 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 + (twitter:update-status (bknr-session-user) + (format nil "Posted news item: http://quickhoney.com/news/~A" title)) (with-http-response () (with-http-body () (html (:html Modified: trunk/projects/quickhoney/src/packages.lisp =================================================================== --- trunk/projects/quickhoney/src/packages.lisp 2008-09-17 09:26:32 UTC (rev 3911) +++ trunk/projects/quickhoney/src/packages.lisp 2008-09-17 11:47:43 UTC (rev 3912) @@ -77,5 +77,5 @@ (:use :cl)) (defpackage :twitter - (:use :cl) + (:use :cl :bknr.datastore) (:export #:update-status)) \ No newline at end of file Modified: trunk/projects/quickhoney/src/quickhoney.asd =================================================================== --- trunk/projects/quickhoney/src/quickhoney.asd 2008-09-17 09:26:32 UTC (rev 3911) +++ trunk/projects/quickhoney/src/quickhoney.asd 2008-09-17 11:47:43 UTC (rev 3912) @@ -33,6 +33,7 @@ (:file "layout" :depends-on ("config")) (:file "imageproc" :depends-on ("config")) (:file "json" :depends-on ("packages")) + (:file "twitter" :depends-on ("packages")) (:file "handlers" :depends-on ("json" "layout" "config" "image" "news")) (:file "tags" :depends-on ("image")) (:file "webserver" :depends-on ("handlers")) Modified: trunk/projects/quickhoney/src/twitter.lisp =================================================================== --- trunk/projects/quickhoney/src/twitter.lisp 2008-09-17 09:26:32 UTC (rev 3911) +++ trunk/projects/quickhoney/src/twitter.lisp 2008-09-17 11:47:43 UTC (rev 3912) @@ -1,12 +1,33 @@ (in-package :twitter) -(defparameter *authorization* '("QuickHoneyTest" "autotwitter") - "Authorization (USER PASSWORD) to use to identify to twitter") +(define-persistent-class account () + ((user :read + :type bknr.user:user + :documentation "USER that this Twitter account belongs to") + (authorization :update + :documentation "List of username and password for this account"))) -(defun update-status (status-string) - (babel:octets-to-string - (drakma:http-request "http://twitter.com/statuses/update.xml" - :method :post - :content (format nil "status=~A" status-string) - :content-type "application/x-www-form-urlencoded" - :basic-authorization *authorization*))) \ No newline at end of file +(define-condition cannot-update-status (error) + ((result :initarg :result :reader result))) + +(define-condition no-account-for-user (error) + ((user :initarg :user :reader user))) + +(defgeneric update-status (who status-string &key) + + (:method ((account account) status-string &key) + (let ((result (babel:octets-to-string + (drakma:http-request "http://twitter.com/statuses/update.xml" + :method :post + :content (format nil "status=~A" status-string) + :content-type "application/x-www-form-urlencoded" + :basic-authorization (account-authorization account))))) + (when (cl-ppcre:scan "<error>" result) + (error 'cannot-update-status :result result)))) + + (:method ((user bknr.user:user) status-string &key errorp) + (let ((account (find user (class-instances 'account) :key #'account-user))) + (if account + (update-status account status-string) + (when errorp + (error 'no-account-for-user :user user)))))) \ No newline at end of file Modified: trunk/projects/quickhoney/website/static/javascript.js =================================================================== --- trunk/projects/quickhoney/website/static/javascript.js 2008-09-17 09:26:32 UTC (rev 3911) +++ trunk/projects/quickhoney/website/static/javascript.js 2008-09-17 11:47:43 UTC (rev 3912) @@ -1,5 +1,8 @@ -// -*- Java -*- +// This may look like -*- Java -*-, but it really is JavaScript +// Copyright 2005-2008 Hans Huebner, hans.huebner(a)gmail.com +// All rights reserved. + /* configuration */ var max_news_items = 50; /* maximum number of news items to display */

1 0

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

17 Sep '08

Revision: 3911 Author: hans URL: http://bknr.net/trac/changeset/3911 tweak last change 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-17 09:24:51 UTC (rev 3910) +++ trunk/projects/quickhoney/website/static/javascript.js 2008-09-17 09:26:32 UTC (rev 3911) @@ -561,7 +561,7 @@ if (!pages[pagename]) { document.location.href = '/'; - return; + return false; } var page = pages[pagename];

1 0

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

17 Sep '08

Revision: 3910 Author: hans URL: http://bknr.net/trac/changeset/3910 Handle unknown paths by redirecting to the home page. 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-16 19:02:57 UTC (rev 3909) +++ trunk/projects/quickhoney/website/static/javascript.js 2008-09-17 09:24:51 UTC (rev 3910) @@ -472,7 +472,11 @@ } log('got ', query_result.length.toString(), ' images'); - display_query_result(); + if (query_result.length) { + display_query_result(); + } else { + document.location.href = '/#home'; + } } function query_imagedb(directory, subdirectory, force) { @@ -554,6 +558,12 @@ } function show_page(pagename, subpath) { + + if (!pages[pagename]) { + document.location.href = '/'; + return; + } + var page = pages[pagename]; log('show_page ' + pagename + ' subpath ' + subpath + ' current_directory ' + current_directory);

1 0

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

16 Sep '08

Revision: 3909 Author: hans URL: http://bknr.net/trac/changeset/3909 Fix handling of pictures with ampersand in names. Handle invalid paths better (a little). import.lisp latest additions. U trunk/projects/quickhoney/upgrade-stuff/import.lisp U trunk/projects/quickhoney/website/static/javascript.js Modified: trunk/projects/quickhoney/upgrade-stuff/import.lisp =================================================================== --- trunk/projects/quickhoney/upgrade-stuff/import.lisp 2008-09-16 19:00:31 UTC (rev 3908) +++ trunk/projects/quickhoney/upgrade-stuff/import.lisp 2008-09-16 19:02:57 UTC (rev 3909) @@ -71,6 +71,11 @@ (dolist (image (images-in-category '(:shop))) (setf (slot-value image 'cat-sub) '(:shop :shop)))) +(with-transaction (:make-explicit) + (dolist (image (union (images-in-category '(:vector :nudes)) + (images-in-category '(:pen :nudes)))) + (pushnew :explicit (store-image-keywords image)))) + (with-transaction (:initialize-news) (setf (slot-value (find-rss-channel "quickhoney") 'bknr.rss::items) (sort (remove-if (lambda (image) @@ -79,6 +84,10 @@ #'> :key #'blob-timestamp))) +(with-transaction (:delete-pixel-buttons) + (dolist (keyword '(:parts :icons :editorial :birdview)) + (mapc #'delete-object (get-keywords-intersection-store-images (list :pixel :button keyword))))) + (with-transaction (:initialize-animation-mime-types) (dolist (animation (mapcar #'quickhoney-animation-image-animation (class-instances 'quickhoney-animation-image))) Modified: trunk/projects/quickhoney/website/static/javascript.js =================================================================== --- trunk/projects/quickhoney/website/static/javascript.js 2008-09-16 19:00:31 UTC (rev 3908) +++ trunk/projects/quickhoney/website/static/javascript.js 2008-09-16 19:02:57 UTC (rev 3909) @@ -418,10 +418,15 @@ for (var i = 0; i < query_result.length; i++) { if (query_result[i].name == document.show_picture) { display_image(i); + document.show_picture = null; break; } } - document.show_picture = null; + if (document.show_picture) { + /* not found */ + document.show_picture = null; + document.location.href = '#' + current_directory + '/' + current_subdirectory; + } } else { if (document.show_page) { goto_results_page(document.show_page); @@ -730,7 +735,7 @@ function directory(directory_name, subpath) { - log('directory: ', directory_name, ' subpath: ', subpath, ' current_directory: ', current_directory); + log('directory: ' + directory_name + ' subpath: ' + subpath + ' current_directory: ' + current_directory); replaceChildNodes("thumbnails", " "); @@ -1187,7 +1192,7 @@ log('jump_to - path is ', path); - path = decodeURI(path.replace(/[&#].*/, "")); + path = decodeURI(path.replace(/[?#].*/, "")); var components = path.split("/"); show_page(components[0], path.replace(/.*?($|\/(.*))/, "$2")); }

1 0

[bknr-cvs] hans changed trunk/bknr/web/src/images/image.lisp
by BKNR Commits 16 Sep '08

16 Sep '08

Revision: 3908 Author: hans URL: http://bknr.net/trac/changeset/3908 Fix recursive directory search to use wildcarded pathname. U trunk/bknr/web/src/images/image.lisp Modified: trunk/bknr/web/src/images/image.lisp =================================================================== --- trunk/bknr/web/src/images/image.lisp 2008-09-16 18:33:54 UTC (rev 3907) +++ trunk/bknr/web/src/images/image.lisp 2008-09-16 19:00:31 UTC (rev 3908) @@ -152,18 +152,9 @@ :type (bknr.utils:image-type-symbol (cdr (assoc :content-type headers))) args))))) -(defun directory-recursive (pathname &key list-directories) - (loop for file in (directory (merge-pathnames #P"**/*.*" pathname)) - when (pathname-name file) - collect file - unless (pathname-name file) - nconc (directory-recursive file) - and when list-directories - collect file)) - -(defun image-directory-recursive (pathname &key list-directories) +(defun image-directory-recursive (pathname) (remove-if-not #'pathname-content-type - (directory-recursive pathname :list-directories list-directories))) + (directory (merge-pathnames #P"**/*.*" pathname)))) (defun import-directory (pathname &key user keywords (spool *user-spool-directory-root*) keywords-from-dir (class-name 'store-image) (delete-files t)) @@ -172,7 +163,7 @@ (unless (subdir-p pathname spool) (error "imported directory ~a is not a subdir of spool ~a~%" pathname spool)) - (loop for file in (image-directory-recursive pathname :list-directories t) + (loop for file in (image-directory-recursive pathname) when (pathname-name file) collect (handler-case (let ((image (import-image

1 0

[bknr-cvs] hans changed trunk/projects/quickhoney/website/templates/index.xml
by BKNR Commits 16 Sep '08

16 Sep '08

Revision: 3907 Author: hans URL: http://bknr.net/trac/changeset/3907 HTML compliance fix U trunk/projects/quickhoney/website/templates/index.xml Modified: trunk/projects/quickhoney/website/templates/index.xml =================================================================== --- trunk/projects/quickhoney/website/templates/index.xml 2008-09-16 14:42:04 UTC (rev 3906) +++ trunk/projects/quickhoney/website/templates/index.xml 2008-09-16 18:33:54 UTC (rev 3907) @@ -213,7 +213,7 @@ <p class="cms"> Category: <select name="subdirectory" size="1"> - <option selected="selected"></option> + <option selected="selected"> </option> <option>birdview</option> <option>parts</option> <option>icons</option>

1 0

[bknr-cvs] hans changed trunk/projects/quickhoney/website/templates/index.xml
by BKNR Commits 16 Sep '08

16 Sep '08

Revision: 3906 Author: hans URL: http://bknr.net/trac/changeset/3906 Change GA tracking code. U trunk/projects/quickhoney/website/templates/index.xml Modified: trunk/projects/quickhoney/website/templates/index.xml =================================================================== --- trunk/projects/quickhoney/website/templates/index.xml 2008-09-16 14:30:16 UTC (rev 3905) +++ trunk/projects/quickhoney/website/templates/index.xml 2008-09-16 14:42:04 UTC (rev 3906) @@ -338,7 +338,7 @@ 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"); +var pageTracker = _gat._getTracker("UA-3432041-5"); pageTracker._trackPageview(); </script> <script language="javascript" type="text/javascript">

1 0

[bknr-cvs] hans changed trunk/
by BKNR Commits 16 Sep '08

16 Sep '08

Revision: 3905 Author: hans URL: http://bknr.net/trac/changeset/3905 Last minute deployment changes for Quickhoney. U trunk/bknr/web/src/images/image.lisp U trunk/projects/quickhoney/src/handlers.lisp U trunk/projects/quickhoney/src/init.lisp U trunk/projects/quickhoney/src/webserver.lisp U trunk/projects/quickhoney/upgrade-stuff/import.lisp Modified: trunk/bknr/web/src/images/image.lisp =================================================================== --- trunk/bknr/web/src/images/image.lisp 2008-09-16 14:27:23 UTC (rev 3904) +++ trunk/bknr/web/src/images/image.lisp 2008-09-16 14:30:16 UTC (rev 3905) @@ -166,7 +166,7 @@ (directory-recursive pathname :list-directories list-directories))) (defun import-directory (pathname &key user keywords (spool *user-spool-directory-root*) - keywords-from-dir (class-name 'store-image)) + keywords-from-dir (class-name 'store-image) (delete-files t)) "Import all files from directory by giving them relative names" (let ((path-spool (cdr (pathname-directory spool)))) (unless (subdir-p pathname spool) Modified: trunk/projects/quickhoney/src/handlers.lisp =================================================================== --- trunk/projects/quickhoney/src/handlers.lisp 2008-09-16 14:27:23 UTC (rev 3904) +++ trunk/projects/quickhoney/src/handlers.lisp 2008-09-16 14:30:16 UTC (rev 3905) @@ -551,3 +551,9 @@ (encode-array-element (first month)) (encode-array-element (second month)))))))) +(defclass shutdown-handler (admin-only-handler page-handler) + ()) + +(defmethod handle ((handler shutdown-handler)) + (hunchentoot:stop-server hunchentoot:*server*) + "Shutting down HTTP server") \ No newline at end of file Modified: trunk/projects/quickhoney/src/init.lisp =================================================================== --- trunk/projects/quickhoney/src/init.lisp 2008-09-16 14:27:23 UTC (rev 3904) +++ trunk/projects/quickhoney/src/init.lisp 2008-09-16 14:30:16 UTC (rev 3905) @@ -30,11 +30,14 @@ (cl-gd::load-gd-glue))) (ensure-directories-exist (setf tbnl:*tmp-directory* (merge-pathnames "hunchentoot-tmp/" *store-directory*))) - #+cmu (actor-start (make-instance 'cron-actor)) (publish-quickhoney) (when (probe-file "site-config.lisp") (format t "; loading site configuration file~%") (let ((*package* (find-package :quickhoney.config))) (load "site-config.lisp"))) - (hunchentoot:start-server :port *webserver-port*)) + (bt:make-thread (curry #'hunchentoot:start-server + :port *webserver-port* + :threaded nil + :persistent-connections-p nil) + :name (format nil "HTTP server on port ~A" *webserver-port*))) Modified: trunk/projects/quickhoney/src/webserver.lisp =================================================================== --- trunk/projects/quickhoney/src/webserver.lisp 2008-09-16 14:27:23 UTC (rev 3904) +++ trunk/projects/quickhoney/src/webserver.lisp 2008-09-16 14:30:16 UTC (rev 3905) @@ -37,6 +37,7 @@ ("/digg-image" digg-image-handler) ("/json-news-archive" json-news-archive-handler) ("/json-news" json-news-handler) + ("/shutdown" shutdown-handler) user images ("/static" directory-handler Modified: trunk/projects/quickhoney/upgrade-stuff/import.lisp =================================================================== --- trunk/projects/quickhoney/upgrade-stuff/import.lisp 2008-09-16 14:27:23 UTC (rev 3904) +++ trunk/projects/quickhoney/upgrade-stuff/import.lisp 2008-09-16 14:30:16 UTC (rev 3905) @@ -118,4 +118,8 @@ (dolist (pathname (directory (merge-pathnames #P"**/*.*" directory-pathname))) (if (member (pathname-type pathname) '(:png :gif :jpg) :test #'string-equal) (import-or-update-image pathname) - (warn "Ignoring file ~A with unknown extension" pathname)))) \ No newline at end of file + (warn "Ignoring file ~A with unknown extension" pathname)))) + +(defun clean-pixel-images () + (mapc #'delete-object (images-in-category '(:pixel :editorial))) + (mapc #'delete-object (images-in-category '(:pixel :parts)))) \ No newline at end of file

1 0