bknr-cvs July 2008

bknr-cvs@common-lisp.net

1 participants
321 discussions

[bknr-cvs] ksprotte changed trunk/projects/bos/test/allocation.lisp
by BKNR Commits 23 Jul '08

23 Jul '08

Revision: 3573 Author: ksprotte URL: http://bknr.net/trac/changeset/3573 avoid compiler warning in test allocation.disconnected-m2s.1 U trunk/projects/bos/test/allocation.lisp Modified: trunk/projects/bos/test/allocation.lisp =================================================================== --- trunk/projects/bos/test/allocation.lisp 2008-07-23 09:28:59 UTC (rev 3572) +++ trunk/projects/bos/test/allocation.lisp 2008-07-23 09:34:27 UTC (rev 3573) @@ -224,10 +224,12 @@ (7202 . 5214) (7204 . 5205) (7195 . 5197)))) (sponsor (make-sponsor :login "test-sponsor")) (m2-counts '(12 43 29 3))) + (declare (ignore area)) (dolist (m2-count m2-counts) (let ((contract (make-contract sponsor m2-count))) (print (list 'make-contract-returned contract)))) ;; This following check reported: ;; WARNING: #<CONTRACT ID: 32131, unpaid> has m2s that are not ;; connected - (is (bos.m2::consistent-p))))) \ No newline at end of file + (is (bos.m2::consistent-p))))) +

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/test/fixtures.lisp
by BKNR Commits 23 Jul '08

23 Jul '08

Revision: 3572 Author: ksprotte URL: http://bknr.net/trac/changeset/3572 5am fixture initial-bos-store now allows for switching off deletion of the test-store (on by default) U trunk/projects/bos/test/fixtures.lisp Modified: trunk/projects/bos/test/fixtures.lisp =================================================================== --- trunk/projects/bos/test/fixtures.lisp 2008-07-23 09:28:10 UTC (rev 3571) +++ trunk/projects/bos/test/fixtures.lisp 2008-07-23 09:28:59 UTC (rev 3572) @@ -46,7 +46,7 @@ (,@store-object-vars) ,@body)) -(def-fixture initial-bos-store () +(def-fixture initial-bos-store (&key (delete-store t)) (let ((store-path (parse-namestring (format nil "/tmp/test-store-~D.tmp/" (get-universal-time))))) (unwind-protect @@ -58,7 +58,9 @@ (&body)) (close-store) ;; (cl-fad:delete-directory-and-files store-path) ; fails on ccl - (asdf:run-shell-command "rm -r '~A'" store-path)))) + (if delete-store + (asdf:run-shell-command "rm -r '~A'" store-path) + (warn "not deleting store at ~A" store-path))))) (defmacro store-test (name &body body) `(progn

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/test/allocation.lisp
by BKNR Commits 23 Jul '08

23 Jul '08

Revision: 3571 Author: ksprotte URL: http://bknr.net/trac/changeset/3571 small type in last commit, sorry U trunk/projects/bos/test/allocation.lisp Modified: trunk/projects/bos/test/allocation.lisp =================================================================== --- trunk/projects/bos/test/allocation.lisp 2008-07-23 09:27:20 UTC (rev 3570) +++ trunk/projects/bos/test/allocation.lisp 2008-07-23 09:28:10 UTC (rev 3571) @@ -213,7 +213,7 @@ (finishes (bos.m2::validate-allocation-area-inclusion-cache))))) (test allocation.disconnected-m2s.1 - (with-fixture initial-bos-store (:delete-store t) + (with-fixture initial-bos-store () (let ((area (make-allocation-area #((7193 . 5195) (7351 . 5193) (7340 . 5377) (7185 . 5390) (7174 . 5385) (7166 . 5387) (7156 . 5381) (7150 . 5379) (7143 . 5374) (7136 . 5368) (7135 . 5364) (7135 . 5359) (7140 . 5347) (7145 . 5342) (7148 . 5329)

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/test/allocation.lisp
by BKNR Commits 23 Jul '08

23 Jul '08

Revision: 3570 Author: ksprotte URL: http://bknr.net/trac/changeset/3570 added a test allocation.disconnected-m2s.1 that should fail U trunk/projects/bos/test/allocation.lisp Modified: trunk/projects/bos/test/allocation.lisp =================================================================== --- trunk/projects/bos/test/allocation.lisp 2008-07-23 08:34:26 UTC (rev 3569) +++ trunk/projects/bos/test/allocation.lisp 2008-07-23 09:27:20 UTC (rev 3570) @@ -210,4 +210,24 @@ (test validate-allocation-area-inclusion-cache (with-fixture initial-bos-store () (let ((area1 (make-allocation-rectangle 0 0 8 8))) - (finishes (bos.m2::validate-allocation-area-inclusion-cache))))) \ No newline at end of file + (finishes (bos.m2::validate-allocation-area-inclusion-cache))))) + +(test allocation.disconnected-m2s.1 + (with-fixture initial-bos-store (:delete-store t) + (let ((area (make-allocation-area #((7193 . 5195) (7351 . 5193) (7340 . 5377) (7185 . 5390) (7174 . 5385) + (7166 . 5387) (7156 . 5381) (7150 . 5379) (7143 . 5374) (7136 . 5368) + (7135 . 5364) (7135 . 5359) (7140 . 5347) (7145 . 5342) (7148 . 5329) + (7156 . 5329) (7157 . 5334) (7166 . 5331) (7170 . 5329) (7171 . 5327) + (7174 . 5316) (7184 . 5306) (7185 . 5291) (7196 . 5286) (7197 . 5287) + (7200 . 5287) (7201 . 5284) (7203 . 5275) (7201 . 5264) (7191 . 5249) + (7203 . 5237) (7199 . 5235) (7195 . 5233) (7198 . 5222) (7202 . 5219) + (7202 . 5214) (7204 . 5205) (7195 . 5197)))) + (sponsor (make-sponsor :login "test-sponsor")) + (m2-counts '(12 43 29 3))) + (dolist (m2-count m2-counts) + (let ((contract (make-contract sponsor m2-count))) + (print (list 'make-contract-returned contract)))) + ;; This following check reported: + ;; WARNING: #<CONTRACT ID: 32131, unpaid> has m2s that are not + ;; connected + (is (bos.m2::consistent-p))))) \ No newline at end of file

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/m2/m2.lisp
by BKNR Commits 23 Jul '08

23 Jul '08

Revision: 3569 Author: ksprotte URL: http://bknr.net/trac/changeset/3569 added new function m2s-connected-p for debugging purposes U trunk/projects/bos/m2/m2.lisp Modified: trunk/projects/bos/m2/m2.lisp =================================================================== --- trunk/projects/bos/m2/m2.lisp 2008-07-23 08:24:33 UTC (rev 3568) +++ trunk/projects/bos/m2/m2.lisp 2008-07-23 08:34:26 UTC (rev 3569) @@ -111,6 +111,21 @@ (geo-utm:utm-x-y-to-lon-lat (+ +nw-utm-x+ x) (- +nw-utm-y+ y) +utm-zone+ t))) polygon))) +(defun m2s-connected-p (m2s) + "Is this region of m2 objects geographically connected? We do + not care about associated contracts or anything else." + (labels ((m2-neighbours (m2) + (let ((x (m2-x m2)) + (y (m2-y m2))) + (delete-if (lambda (m2) (not (member m2 m2s))) + (list (get-m2 (1- x) y) + (get-m2 (1+ x) y) + (get-m2 x (1- y)) + (get-m2 x (1+ y))))))) + (geometry:nodes-connected-p m2s + #'m2-neighbours + #'eq))) + ;;;; SPONSOR ;;; Exportierte Funktionen:

1 0

[bknr-cvs] hans changed trunk/projects/bos/web/
by BKNR Commits 23 Jul '08

23 Jul '08

Revision: 3568 Author: hans URL: http://bknr.net/trac/changeset/3568 add cert-issued handler just in case U trunk/projects/bos/web/contract-handlers.lisp U trunk/projects/bos/web/webserver.lisp Modified: trunk/projects/bos/web/contract-handlers.lisp =================================================================== --- trunk/projects/bos/web/contract-handlers.lisp 2008-07-23 07:40:34 UTC (rev 3567) +++ trunk/projects/bos/web/contract-handlers.lisp 2008-07-23 08:24:33 UTC (rev 3568) @@ -34,3 +34,14 @@ (:tr (:td "cert issued?") (:td (:princ-safe (if (contract-cert-issued contract) "yes" "no"))))))) +(defclass cert-issued-handler (object-handler) + () + (:default-initargs :class 'contract)) + +(defmethod handle-object ((handler cert-issued-handler) contract) + (with-http-response (:content-type "text/html; charset=UTF-8") + (with-http-body () + (:princ (if (and (contract-certificates-generated-p contract) + (not (contract-tree-needs-update-p))) + "READY" + "PROCESSING"))))) Modified: trunk/projects/bos/web/webserver.lisp =================================================================== --- trunk/projects/bos/web/webserver.lisp 2008-07-23 07:40:34 UTC (rev 3567) +++ trunk/projects/bos/web/webserver.lisp 2008-07-23 08:24:33 UTC (rev 3568) @@ -226,6 +226,7 @@ ("/allocation-cache" allocation-cache-handler) ("/certificate" certificate-handler) ("/cert-regen" cert-regen-handler) + ("/cert-issued" cert-issued-handler) ("/admin" admin-handler) ("/languages" languages-handler) ("/overview" image-tile-handler)

1 0

[bknr-cvs] hans changed trunk/bknr/datastore/src/data/object.lisp
by BKNR Commits 23 Jul '08

23 Jul '08

Revision: 3567 Author: hans URL: http://bknr.net/trac/changeset/3567 Warn using FORMAT *TRACE-OUTPUT*, not WARN. U trunk/bknr/datastore/src/data/object.lisp Modified: trunk/bknr/datastore/src/data/object.lisp =================================================================== --- trunk/bknr/datastore/src/data/object.lisp 2008-07-23 07:10:34 UTC (rev 3566) +++ trunk/bknr/datastore/src/data/object.lisp 2008-07-23 07:40:34 UTC (rev 3567) @@ -54,8 +54,8 @@ (when (and (boundp '*store*) *store*) (update-instances-for-changed-class (class-name class)) (unless *suppress-schema-warnings* - (warn "Class ~A has been changed. To ensure correct schema evolution, please snapshot your datastore." - (class-name class))))) + (format *trace-output* "Class ~A has been changed. To ensure correct schema evolution, please snapshot your datastore." + (class-name class))))) (defclass persistent-direct-slot-definition (index-direct-slot-definition) ((transient :initarg :transient :initform nil)

1 0

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

23 Jul '08

Revision: 3566 Author: hans URL: http://bknr.net/trac/changeset/3566 snapshot t-shirt buy widget U trunk/projects/quickhoney/website/static/javascript.js Modified: trunk/projects/quickhoney/website/static/javascript.js =================================================================== --- trunk/projects/quickhoney/website/static/javascript.js 2008-07-22 19:26:59 UTC (rev 3565) +++ trunk/projects/quickhoney/website/static/javascript.js 2008-07-23 07:10:34 UTC (rev 3566) @@ -1260,6 +1260,22 @@ NOTICE("Please note: We are shipping from Germany, that's why there is a sales tax within Europe and none outside")))); }, 'buy-t-shirt' : function () { + make_overlay('buy-t-shirt', 'Buy Art on T-Shirt', 426, + FORM({ method: 'POST', action: '#' }, + SPACER("Artwork ", ARTWORK_NAME(current_image.name), " in colored flocked foil ", + "hot pressed on an American Apparel T-Shirt." + NOTICE('These Tees are custom made, so please allow 4-6 days for production in addition to the shipping time')), + SPACER(TABLE(null, + TBODY(null, + TR(null, + TD({ id: 't-shirt-sample' }, INPUT({ type: "radio", name: "size", value: "small"})), + TD(null, + "Small 20cm x 30cm (7.8'' x 11.8'')", BR(), + PRICE('150 €'), NOTICE(' (inside EU, incl. tax)*'), BR(), + PRICE('128.32 €'), NOTICE(' (outside EU, tax free)*'), BR())),)), + BUTTON(null, IMG({ src: '/image/add-to-cart', width: 102, height: 40 })), + BR(), BR(), + NOTICE("Please note: We are shipping from Germany, that's why there is a sales tax within Europe and none outside")))) } };

1 0

[bknr-cvs] hans changed trunk/projects/bos/m2/
by BKNR Commits 22 Jul '08

22 Jul '08

Revision: 3565 Author: hans URL: http://bknr.net/trac/changeset/3565 Don't use ICONV to convert UTF-8 string to ISO-8859-1 before using cl-qprint to encode the string. This should work fine as long as the string only contains characters from ISO-8859-1. U trunk/projects/bos/m2/bos.m2.asd U trunk/projects/bos/m2/mail-generator.lisp Modified: trunk/projects/bos/m2/bos.m2.asd =================================================================== --- trunk/projects/bos/m2/bos.m2.asd 2008-07-22 18:49:39 UTC (rev 3564) +++ trunk/projects/bos/m2/bos.m2.asd 2008-07-22 19:26:59 UTC (rev 3565) @@ -2,7 +2,7 @@ (asdf:defsystem :bos.m2 :depends-on (:bknr.datastore :bknr.modules :cl-smtp :cl-mime - :iconv :kmrcl :iterate :arnesi + :kmrcl :iterate :arnesi :cl-pdf :screamer :cl-fad) :components ((:file "packages") (:file "geo-utm" :depends-on ("packages")) Modified: trunk/projects/bos/m2/mail-generator.lisp =================================================================== --- trunk/projects/bos/m2/mail-generator.lisp 2008-07-22 18:49:39 UTC (rev 3564) +++ trunk/projects/bos/m2/mail-generator.lisp 2008-07-22 19:26:59 UTC (rev 3565) @@ -81,8 +81,7 @@ (if (listp thing) thing (list thing))) (vcard-field (field-spec &rest values) (let* ((values (mapcar (lambda (value) (or value "")) (ensure-list values))) - (encoded-values (mapcar (lambda (string) (cl-qprint:encode (iconv:iconv "UTF-8" "ISO-8859-1" (or string "")) - :encode-newlines t)) values))) + (encoded-values (mapcar (lambda (string) (cl-qprint:encode (or string "") :encode-newlines t)) values))) (format s "~{~A~^;~}:~{~@[~A~]~^;~}~%" (append (ensure-list field-spec) (unless (equal values encoded-values)

1 0

[bknr-cvs] hans changed trunk/thirdparty/drakma/request.lisp
by BKNR Commits 22 Jul '08

22 Jul '08

Revision: 3564 Author: hans URL: http://bknr.net/trac/changeset/3564 When the caller wants text, always return a string. U trunk/thirdparty/drakma/request.lisp Modified: trunk/thirdparty/drakma/request.lisp =================================================================== --- trunk/thirdparty/drakma/request.lisp 2008-07-22 17:03:24 UTC (rev 3563) +++ trunk/thirdparty/drakma/request.lisp 2008-07-22 18:49:39 UTC (rev 3564) @@ -146,7 +146,7 @@ #+:clisp (setf (flexi-stream-element-type stream) element-type) (multiple-value-prog1 - (values (cond ((eql content-length 0) nil) + (values (cond ((eql content-length 0) (if textp "" nil)) (content-length (when chunkedp ;; see RFC 2616, section 4.4

1 0

← Newer
1
...
12
13
14
15
16
17
18
...
33
Older →

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

bknr-cvs July 2008