November 2008 - bknr-cvs@common-lisp.net - mailman3.common-lisp.net

[bknr-cvs] hans changed trunk/thirdparty/cl-gd-0.5.6/colors.lisp
by BKNR Commits 10 Nov '08

10 Nov '08

Revision: 4032 Author: hans URL: http://bknr.net/trac/changeset/4032 revert previous change U trunk/thirdparty/cl-gd-0.5.6/colors.lisp Modified: trunk/thirdparty/cl-gd-0.5.6/colors.lisp =================================================================== --- trunk/thirdparty/cl-gd-0.5.6/colors.lisp 2008-11-10 10:05:14 UTC (rev 4031) +++ trunk/thirdparty/cl-gd-0.5.6/colors.lisp 2008-11-10 10:07:00 UTC (rev 4032) @@ -200,7 +200,7 @@ (check-type image image) (not (zerop (get-slot-value (img image) 'gd-image 'save-alpha-flag)))) -(defun (setf save-alpha-p) (save &optional (image *default-image*)) +(defun (setf save-alpha-p) (save &key (image *default-image*)) "Determines whether PNG images will be saved with full alpha channel information." (check-type image image)

1 0

[bknr-cvs] hans changed trunk/thirdparty/cl-gd-0.5.6/colors.lisp
by BKNR Commits 10 Nov '08

10 Nov '08

Revision: 4031 Author: hans URL: http://bknr.net/trac/changeset/4031 make save-alpha-p and (setf save-alpha-p) orthogonal U trunk/thirdparty/cl-gd-0.5.6/colors.lisp Modified: trunk/thirdparty/cl-gd-0.5.6/colors.lisp =================================================================== --- trunk/thirdparty/cl-gd-0.5.6/colors.lisp 2008-11-10 09:39:19 UTC (rev 4030) +++ trunk/thirdparty/cl-gd-0.5.6/colors.lisp 2008-11-10 10:05:14 UTC (rev 4031) @@ -200,7 +200,7 @@ (check-type image image) (not (zerop (get-slot-value (img image) 'gd-image 'save-alpha-flag)))) -(defun (setf save-alpha-p) (save &key (image *default-image*)) +(defun (setf save-alpha-p) (save &optional (image *default-image*)) "Determines whether PNG images will be saved with full alpha channel information." (check-type image image)

1 0

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

10 Nov '08

Revision: 4030 Author: hans URL: http://bknr.net/trac/changeset/4030 Always create jpeg images with maximum quality. U trunk/bknr/web/src/images/image.lisp Modified: trunk/bknr/web/src/images/image.lisp =================================================================== --- trunk/bknr/web/src/images/image.lisp 2008-11-10 09:38:22 UTC (rev 4029) +++ trunk/bknr/web/src/images/image.lisp 2008-11-10 09:39:19 UTC (rev 4030) @@ -82,9 +82,12 @@ initargs))) (ensure-directories-exist (blob-pathname store-image)) (ignore-errors (delete-file (blob-pathname store-image))) - (cl-gd:write-image-to-file (blob-pathname store-image) - :image image - :type type) + (apply #'cl-gd:write-image-to-file + (blob-pathname store-image) + :image image + :type type + (when (eq type :jpg) + (list :quality 95))) store-image)) (defmacro with-store-image-from-id ((var id) &rest body)

1 0

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

10 Nov '08

Revision: 4029 Author: hans URL: http://bknr.net/trac/changeset/4029 Improve image quality for uploaded jpg images. U trunk/projects/quickhoney/src/handlers.lisp Modified: trunk/projects/quickhoney/src/handlers.lisp =================================================================== --- trunk/projects/quickhoney/src/handlers.lisp 2008-11-10 08:39:46 UTC (rev 4028) +++ trunk/projects/quickhoney/src/handlers.lisp 2008-11-10 09:38:22 UTC (rev 4029) @@ -303,7 +303,8 @@ (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))) + (cl-gd:true-color-to-palette :image image) + t)) (defmethod handle ((handler upload-image-handler)) (with-query-params (client spider-keywords) @@ -322,7 +323,8 @@ :class-name 'quickhoney-image :keywords (cons :upload (image-keywords-from-request-parameters)) :initargs (list :owner (bknr-session-user) - :cat-sub (mapcar #'make-keyword-from-string (decoded-handler-path handler)) + :cat-sub (mapcar #'make-keyword-from-string + (decoded-handler-path handler)) :client client :spider-keywords spider-keywords)))) (with-http-response () @@ -367,47 +369,49 @@ (defmethod handle ((handler upload-news-handler)) (with-query-params (title text) - (let ((uploaded-file (request-uploaded-file "image-file"))) + (let ((uploaded-file (or (request-uploaded-file "image-file")))) + (unless uploaded-file + (error "no file uploaded")) (handler-case - (progn - (unless uploaded-file - (error "no file uploaded")) - (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* ((name (normalize-news-title title)) - (item (make-store-image :name name - :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" name)) - (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")))))))))) + (with-image-from-upload (uploaded-image uploaded-file) + (let* ((processed (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)) + t)) + (name (normalize-news-title title)) + (args (list :name name + :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)))) + (item (if processed + (apply #'make-store-image :image uploaded-image args) + (apply #'import-image (upload-pathname uploaded-file) args)))) + (declare (ignore item)) ; for now + (twitter:update-status (bknr-session-user) + (format nil "Posted news item: http://quickhoney.com/news/~A" name)) + (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 ()

1 0

[bknr-cvs] hans changed trunk/bknr/web/src/web/tags.lisp
by BKNR Commits 10 Nov '08

10 Nov '08

Revision: 4028 Author: hans URL: http://bknr.net/trac/changeset/4028 Comment out code to avoid a "deleting unreachable code" warning U trunk/bknr/web/src/web/tags.lisp Modified: trunk/bknr/web/src/web/tags.lisp =================================================================== --- trunk/bknr/web/src/web/tags.lisp 2008-11-10 08:27:59 UTC (rev 4027) +++ trunk/bknr/web/src/web/tags.lisp 2008-11-10 08:39:46 UTC (rev 4028) @@ -114,6 +114,7 @@ (defun user-template-prefix () (error 'wtf) + #+(or) (user-preference (bknr-session-user) :template-path-prefix "file:///Volumes/web/template/")) ;; xxx new templater

1 0

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

10 Nov '08

Revision: 4027 Author: hans URL: http://bknr.net/trac/changeset/4027 work on shopping system U trunk/projects/quickhoney/src/packages.lisp U trunk/projects/quickhoney/src/quickhoney.asd U trunk/projects/quickhoney/src/shop.lisp Modified: trunk/projects/quickhoney/src/packages.lisp =================================================================== --- trunk/projects/quickhoney/src/packages.lisp 2008-11-10 08:25:02 UTC (rev 4026) +++ trunk/projects/quickhoney/src/packages.lisp 2008-11-10 08:27:59 UTC (rev 4027) @@ -21,7 +21,16 @@ (:use :cl :bknr.datastore :bknr.indices - :bknr.user)) + :bknr.user) + (:export #:download-product + #:emailable-product + #:mailable-product + #:product-stock-count + #:shopping-cart + #:put-to-cart + #:insufficient-inventory + #:product-already-in-shopping-cart + #:fulfill)) (defpackage :quickhoney (:use :cl Modified: trunk/projects/quickhoney/src/quickhoney.asd =================================================================== --- trunk/projects/quickhoney/src/quickhoney.asd 2008-11-10 08:25:02 UTC (rev 4026) +++ trunk/projects/quickhoney/src/quickhoney.asd 2008-11-10 08:27:59 UTC (rev 4027) @@ -24,7 +24,8 @@ :bknr.web :bknr.datastore :bknr.modules - :cl-gd) + :cl-gd + :unit-test) :components ((:file "packages") (:file "config" :depends-on ("packages")) Modified: trunk/projects/quickhoney/src/shop.lisp =================================================================== --- trunk/projects/quickhoney/src/shop.lisp 2008-11-10 08:25:02 UTC (rev 4026) +++ trunk/projects/quickhoney/src/shop.lisp 2008-11-10 08:27:59 UTC (rev 4027) @@ -28,7 +28,6 @@ :update :type string :index-type string-unique-index - :index-reader product-with-name :documentation "Short name of the product, must be unique, should be identifier") (description @@ -41,10 +40,13 @@ (:documentation "Sell PRODUCT, adjusting the stock count if needed. Returns the product sold.")) -(defgeneric stock-count (product) +(defgeneric product-stock-count (product) (:documentation "Return the number of instances of PRODUCT available, or NIL if the - product can be sold in infinite amounts.")) + product can be sold in infinite amounts.") + (:method (product) + "By default, assume infinite supply" + nil)) (define-persistent-class download-product (product) () @@ -54,9 +56,6 @@ address. Once paid, the system makes the product available to the customer for download.")) -(defmethod stock-count ((product download-product)) - nil) - (define-persistent-class emailable-product (product) () (:documentation @@ -65,20 +64,40 @@ be supplied by the customer. Once paid, the system sends the order to the store personnel for fulfillment.")) -(defmethod stock-count ((product emailable-product)) - nil) - (define-persistent-class mailable-product (product) ((stock-count :update :type integer - :accessor stock-count + :accessor product-stock-count :documentation - "Number of instances of this product that are available to be sold.")) + "Number of instances of this product that are + available to be sold, including reserved amounts in + shopping carts.") + (reserved-count :update + :type integer + :initform 0)) (:documentation "A product that is sent to the customer by regular mail \(i.e. a t-shirt or poster). Once paid, the system sends the order to the store personell for fulfillment.")) +(defgeneric available-p (product count) + (:documentation "Return a true value if COUNT units of PRODUCT are + currently available. Should be called with the store guard locked.") + (:method (product count) + (or (null (product-stock-count product)) + (<= count (product-stock-count product))))) + +(defmethod product-stock-count ((product mailable-product)) + "The available stock count for a mailable product is reduced by the reserved count and returned." + (- (slot-value product 'stock-count) + (mailable-product-reserved-count product))) + +(defmethod (setf product-stock-count) (newval (product mailable-product)) + "The available sock count for a mailable product is set to NEWVAL." + (when (< newval (mailable-product-reserved-count product)) + (error "cannot reduce the available stock count below the reserved count")) + (setf (slot-value product 'stock-count) newval)) + (define-persistent-class shipping-address () ((country :read)) (:documentation @@ -99,9 +118,28 @@ "List of shipping addresses with the preferred address being the CAR of the list."))) +(define-persistent-class number-generator () + ((name :read + :type symbol + :initform (error "cannot make number-generator instance without name") + :index-type string-unique-index + :index-reader number-generator-with-name) + (next :update + :type integer + :initarg :next + :initform 1))) + +(defun get-next-number (name) + (with-transaction (:get-next-number) + (let* ((number-generator (or (number-generator-with-name name) + (make-instance 'number-generator :name name))) + (number (number-generator-next number-generator))) + (incf (number-generator-next number-generator)) + number))) + (define-persistent-class order () ((number :read - :initform (make-order-number)) + :initform (get-next-number 'orders)) (customer :read) (items :update))) @@ -112,6 +150,161 @@ (define-persistent-class invoice () ((number :read - :initform (make-invoice-number)) + :initform (get-next-number 'invoices)) (items :update))) +(define-persistent-class lease () + ((product :read + :initform (error "missing :product initarg to lease creation") + :documentation "product that has been leased") + (count :read + :initform (error "missing :count initarg to lease creation") + :documentation "number of units of product held by this lease") + (fulfilled :update + :initform nil + :documentation "Set to a true value when the lease has + been fulfilled. Used during lease descruction in order + to determine whether to return the leased inventory to + the product stock.")) + (:documentation "Instance representing a lease for a product.")) + +(defgeneric update-reserved-stock (product count) + (:documentation "Update the reserved counter of PRODUCT by COUNT units") + (:method (product count) + (declare (ignore product count)))) + +(defgeneric note-sale (product count) + (:documentation "Update the stock count of the PRODUCT by COUNT + units after a sale has been done") + (:method (product count) + (declare (ignore product count)))) + +(defmethod initialize-instance :after ((lease lease) &key) + (update-reserved-stock (lease-product lease) (lease-count lease))) + +(defmethod destroy-object :before ((lease lease)) + (unless (lease-fulfilled lease) + (update-reserved-stock (lease-product lease) (- (lease-count lease))))) + +(defmethod update-reserved-stock ((product mailable-product) count) + (incf (mailable-product-reserved-count product) count)) + +(defmethod note-sale ((product mailable-product) count) + (decf (slot-value product 'stock-count) count) + (update-reserved-stock product (- count))) + +(define-persistent-class shopping-cart () + ((leases :update + :initform nil) + (expires :read + :initform (error "missing :expires initarg to shopping cart creation") + :documentation "universal time at which this shopping cart expires")) + (:documentation "Represents the intent to buy goods, in the form of LEASE objects")) + +(defmethod destroy-object :before ((shopping-cart shopping-cart)) + (mapc #'delete-object (shopping-cart-leases shopping-cart))) + +(define-condition insufficient-inventory (error) + ((product :initarg :product + :reader product) + (requested :initarg :requested + :reader requested) + (available :initarg :available + :reader available)) + (:report (lambda (c stream) + (format stream "Insufficient inventory for product ~A - Requested ~A, but~[~; only~]~:* ~A available" + (product c) (requested c) (available c)) + c))) + +(define-condition product-already-in-shopping-cart (error) + ((product :initarg :product + :reader product)) + (:report (lambda (c stream) + (format stream "Product ~A is already in shopping cart" + (product c))))) + +(defun put-to-shopping-cart (count product shopping-cart) + "Reserve COUNT units of PRODUCT, signalling a INSUFFICIENT-INVENTORY + error if not enough inventory of PRODUCT is available. Returns a + LEASE object." + (with-store-guard () + (unless (available-p product count) + (error 'insufficient-inventory + :product product + :requested count + :available (product-stock-count product))) + (when (find product (shopping-cart-leases shopping-cart) + :key #'lease-product) + (error 'product-already-in-shopping-cart + :product product)) + (with-transaction (:make-lease) + (push (make-instance 'lease + :product product + :count count) + (shopping-cart-leases shopping-cart))))) + +(defun fulfill (shopping-cart) + "Fulfill the given shopping cart." + (with-transaction (:fulfill) + (dolist (lease (shopping-cart-leases shopping-cart)) + (let ((product (lease-product lease)) + (count (lease-count lease))) + (setf (lease-fulfilled lease) t) + (note-sale product count))) + (delete-object shopping-cart))) + +;;; TESTING + +(defmacro with-temporary-directory ((pathname) &body body) + `(let ((,pathname (pathname (format nil "/tmp/store-test-~A/" (sb-posix:getpid))))) + (asdf:run-shell-command "rm -rf ~A" ,pathname) + (prog1 + (progn ,@body) + (asdf:run-shell-command "rm -rf ~A" ,pathname)))) + +(defun do-with-test-store (thunk) + (when (and (boundp '*store*) *store*) + (warn "closing open store *store* to run tests") + (close-store)) + (with-temporary-directory (store-directory) + (make-instance 'mp-store + :subsystems (list (make-instance 'store-object-subsystem)) + :directory store-directory) + (funcall thunk) + (close-store))) + +(defmacro with-test-store (() &body body) + `(do-with-test-store (lambda () ,@body))) + +(unit-test:deftest :shop "lease and cart tests" + (with-test-store () + (let* ((t-shirt (make-instance 'mailable-product :name 't-shirt :stock-count 10)) + (file (make-instance 'download-product :name 'file)) + (shopping-cart (make-instance 'shopping-cart :expires (+ (* 60 10) (get-universal-time))))) + (unit-test:test-equal 10 (product-stock-count t-shirt)) + (put-to-shopping-cart 10 t-shirt shopping-cart) + (unit-test:test-equal 0 (product-stock-count t-shirt)) + (unit-test:test-assert (product-stock-count t-shirt)) + (with-transaction (:add-to-inventory) + (incf (slot-value t-shirt 'stock-count) 10)) + (put-to-shopping-cart 5 t-shirt shopping-cart) + (unit-test:test-equal 5 (product-stock-count t-shirt)) + (delete-object shopping-cart) + (unit-test:test-equal 20 (product-stock-count t-shirt)) + (setf shopping-cart (make-instance 'shopping-cart :expires (+ (* 60 10) (get-universal-time)))) + (put-to-shopping-cart 5 t-shirt shopping-cart) + (put-to-shopping-cart 500 file shopping-cart) + (unit-test:test-equal 15 (product-stock-count t-shirt))))) + +(unit-test:deftest :shop "fulfill test" + (with-test-store () + (let* ((t-shirt (make-instance 'mailable-product :name 't-shirt :stock-count 10)) + (file (make-instance 'download-product :name 'file)) + (shopping-cart (make-instance 'shopping-cart :expires (+ (* 60 10) (get-universal-time))))) + (put-to-shopping-cart 3 t-shirt shopping-cart) + (put-to-shopping-cart 7 file shopping-cart) + (fulfill shopping-cart) + (unit-test:test-equal 7 (product-stock-count t-shirt)) + (unit-test:test-equal 0 (length (class-instances 'shopping-cart))) + (unit-test:test-equal 0 (length (class-instances 'lease))) + (unit-test:test-equal 0 (mailable-product-reserved-count t-shirt))))) \ No newline at end of file

1 0

[bknr-cvs] hans changed trunk/bknr/
by BKNR Commits 10 Nov '08

10 Nov '08

Revision: 4026 Author: hans URL: http://bknr.net/trac/changeset/4026 resolve conflicts with alexandria U trunk/bknr/datastore/src/data/package.lisp U trunk/bknr/datastore/src/utils/package.lisp U trunk/bknr/datastore/src/utils/utils.lisp U trunk/bknr/modules/text/package.lisp U trunk/bknr/web/src/packages.lisp Modified: trunk/bknr/datastore/src/data/package.lisp =================================================================== --- trunk/bknr/datastore/src/data/package.lisp 2008-11-10 08:20:25 UTC (rev 4025) +++ trunk/bknr/datastore/src/data/package.lisp 2008-11-10 08:25:02 UTC (rev 4026) @@ -3,10 +3,11 @@ (defpackage :bknr.datastore (:use :cl :bknr.utils :cl-interpol :cl-ppcre :bknr.indices :bknr.statistics - :closer-mop ) + :closer-mop :alexandria) #+cmu (:shadowing-import-from :common-lisp #:subtypep #:typep) (:shadowing-import-from :cl-interpol quote-meta-chars) + (:shadowing-import-from :bknr.indices array-index) #| (:shadow :cl #:get-internal-run-time #:get-internal-real-time #:get-universal-time #:sleep) |# (:export #:*store-debug* #:*store* Modified: trunk/bknr/datastore/src/utils/package.lisp =================================================================== --- trunk/bknr/datastore/src/utils/package.lisp 2008-11-10 08:20:25 UTC (rev 4025) +++ trunk/bknr/datastore/src/utils/package.lisp 2008-11-10 08:25:02 UTC (rev 4026) @@ -35,8 +35,6 @@ #:parse-time ;; filesystem functions - #:copy-stream - #:copy-file #:move-file #:directory-empty-p #:subdir-p Modified: trunk/bknr/datastore/src/utils/utils.lisp =================================================================== --- trunk/bknr/datastore/src/utils/utils.lisp 2008-11-10 08:20:25 UTC (rev 4025) +++ trunk/bknr/datastore/src/utils/utils.lisp 2008-11-10 08:25:02 UTC (rev 4026) @@ -163,19 +163,6 @@ 0 (length (pathname-directory dir))) (pathname-directory dir))))) -(defun copy-file (source target &key (overwrite t)) - (let ((buffer (make-array 4096 :element-type '(unsigned-byte 8))) - (read-count 0)) - (with-open-file (in source :direction :input - :element-type '(unsigned-byte 8)) - (with-open-file (out target :direction :output - :element-type '(unsigned-byte 8) - :if-exists (if overwrite :overwrite :error) :if-does-not-exist :create) - (loop - (setf read-count (read-sequence buffer in)) - (write-sequence buffer out :end read-count) - (when (< read-count 4096) (return))))))) - (defun move-file (file1 file2) #+(or allegro openmcl) (rename-file file1 file2) @@ -186,19 +173,6 @@ (sb-unix:unix-rename (namestring file1) (namestring file2))) -(defun copy-stream (in out &optional (element-type '(unsigned-byte 8))) - "Copy everything from in to out" - (let* ((buffer-size 4096) - (buffer (make-array buffer-size :element-type element-type))) - (labels ((read-chunks () - (let ((size (read-sequence buffer in))) - (if (< size buffer-size) - (write-sequence buffer out :start 0 :end size) - (progn - (write-sequence buffer out) - (read-chunks)))))) - (read-chunks)))) - (defun make-temporary-pathname (&key (defaults nil) (name "tmp")) (loop for file = (make-pathname :name (format nil "~A-~A-~A" name Modified: trunk/bknr/modules/text/package.lisp =================================================================== --- trunk/bknr/modules/text/package.lisp 2008-11-10 08:20:25 UTC (rev 4025) +++ trunk/bknr/modules/text/package.lisp 2008-11-10 08:25:02 UTC (rev 4026) @@ -18,7 +18,6 @@ :alexandria) (:shadowing-import-from :bknr.indices array-index) (:shadowing-import-from :cl-interpol quote-meta-chars) - (:shadowing-import-from :alexandria #:copy-stream #:copy-file) (:export ;; billboards #:list-billboards-page Modified: trunk/bknr/web/src/packages.lisp =================================================================== --- trunk/bknr/web/src/packages.lisp 2008-11-10 08:20:25 UTC (rev 4025) +++ trunk/bknr/web/src/packages.lisp 2008-11-10 08:25:02 UTC (rev 4026) @@ -164,7 +164,6 @@ (:shadowing-import-from :cl-interpol #:quote-meta-chars) (:shadowing-import-from :hunchentoot #:host) (:shadowing-import-from :alexandria #:array-index) - (:shadowing-import-from :alexandria #:copy-stream #:copy-file) (:export #:*user* #:with-http-request #:with-http-body @@ -405,7 +404,6 @@ :bknr.user) (:shadowing-import-from :cl-interpol #:quote-meta-chars) (:shadowing-import-from :bknr.indices #:array-index) - (:shadowing-import-from :alexandria #:copy-stream #:copy-file) (:export #:imageproc #:define-imageproc-handler #:image-handler ; plain images only

1 0

[bknr-cvs] hans changed buildbot/master/master.cfg
by BKNR Commits 10 Nov '08

10 Nov '08

Revision: 4025 Author: hans URL: http://bknr.net/trac/changeset/4025 Remove linux builder for now. U buildbot/master/master.cfg Modified: buildbot/master/master.cfg =================================================================== --- buildbot/master/master.cfg 2008-11-01 10:06:28 UTC (rev 4024) +++ buildbot/master/master.cfg 2008-11-10 08:20:25 UTC (rev 4025) @@ -7,7 +7,6 @@ from buildbot.buildslave import BuildSlave c['slaves'] = [BuildSlave("paracetamol", "bknrbu1ld", max_builds=1), BuildSlave("netzhansa.com", "bknrbu1ld", max_builds=1), - BuildSlave("lisp.homelinux.net", "bknrbu1ld", max_builds=1), BuildSlave("test.createrainforest.org", "bknrbu1ld", max_builds=1), BuildSlave("harald.headcraft.de", "bknrbu1ld", max_builds=1)] @@ -29,7 +28,6 @@ builderNames=["bknr-fbsd-ccl-amd64", "bknr-fbsd-sbcl-amd64", "bknr-fbsd-sbcl-i386", - "bknr-linux-sbcl-i386", "bknr-darwin-ccl-ppc", #"bknr-linux-cmucl-i386", #"bknr-fbsd-cmucl-i386", @@ -71,11 +69,6 @@ 'builddir': "bknr-fbsd-sbcl-i386", 'factory': make_bknr_factory("trunk", "sbcl"), }, - {'name': "bknr-linux-sbcl-i386", - 'slavename': "lisp.homelinux.net", - 'builddir': "bknr-linux-sbcl-i386", - 'factory': make_bknr_factory("trunk", "sbcl"), - }, {'name': "bknr-darwin-ccl-ppc", 'slavename': "harald.headcraft.de", 'builddir': "bknr-darwin-ccl-ppc",

1 0

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

01 Nov '08

Revision: 4024 Author: hans URL: http://bknr.net/trac/changeset/4024 Revive full image display. A trunk/projects/quickhoney/website/static/image-full.html U trunk/projects/quickhoney/website/static/javascript.js D trunk/projects/quickhoney/website/templates/image-full.xml Added: trunk/projects/quickhoney/website/static/image-full.html =================================================================== --- trunk/projects/quickhoney/website/static/image-full.html (rev 0) +++ trunk/projects/quickhoney/website/static/image-full.html 2008-11-01 10:06:28 UTC (rev 4024) @@ -0,0 +1,26 @@ +<?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"> +<html xmlns="http://www.w3.org/1999/xhtml"> + <head> + <link rel="stylesheet" href="/static/yui/reset-fonts/reset-fonts.css,image-full.css" /> + <script src="/static/image-full.js" type="text/javascript"> </script> + <title>QuickHoney image</title> + </head> + <body id="imagedetail"> + <div id="logo"> + <a href="javascript:window.close()"> + <img src="/image/quickhoney-black" id="the_logo" name="logo" border="0" /> + </a> + </div> + + <div id="image"> + <a href="javascript:window.close()"> + <img src="/image/trans" id="the_image" name="image" border="0" /> + </a> + </div> + </body> + <script language="javascript"> + load_image(); + </script> +</html> Modified: trunk/projects/quickhoney/website/static/javascript.js =================================================================== --- trunk/projects/quickhoney/website/static/javascript.js 2008-10-30 16:12:57 UTC (rev 4023) +++ trunk/projects/quickhoney/website/static/javascript.js 2008-11-01 10:06:28 UTC (rev 4024) @@ -1200,7 +1200,7 @@ } function enlarge() { - var detail_window = open("image-full#" + encodeURI(current_image.name), + var detail_window = open("/static/image-full.html#" + encodeURI(current_image.name), "_new", "width=" + current_image.width + ",height=" + current_image.height + ",status=no,toolbar=no,menubar=no"); Deleted: trunk/projects/quickhoney/website/templates/image-full.xml =================================================================== --- trunk/projects/quickhoney/website/templates/image-full.xml 2008-10-30 16:12:57 UTC (rev 4023) +++ trunk/projects/quickhoney/website/templates/image-full.xml 2008-11-01 10:06:28 UTC (rev 4024) @@ -1,29 +0,0 @@ -<?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"> -<html - xmlns="http://www.w3.org/1999/xhtml" - xmlns:bknr="http://bknr.net" - > - <head> - <link rel="stylesheet" href="/static/yui/reset-fonts/reset-fonts.css,image-full.css" /> - <script src="/static/image-full.js" type="text/javascript"> </script> - <title>QuickHoney image</title> - </head> - <body id="imagedetail"> - <div id="logo"> - <a href="javascript:window.close()"> - <img src="/image/quickhoney-black" id="the_logo" name="logo" border="0" /> - </a> - </div> - - <div id="image"> - <a href="javascript:window.close()"> - <img src="/image/trans" id="the_image" name="image" border="0" /> - </a> - </div> - </body> - <script language="javascript"> - load_image(); - </script> -</html>

1 0