[bknr-cvs] r2098 - in trunk/projects/bos: m2 worldpay-test
bknr at bknr.net
bknr at bknr.net
Sun Dec 3 10:47:40 UTC 2006
Author: hhubner
Date: 2006-12-03 05:47:39 -0500 (Sun, 03 Dec 2006)
New Revision: 2098
Modified:
trunk/projects/bos/m2/bitmap.lisp
trunk/projects/bos/m2/m2.lisp
trunk/projects/bos/m2/packages.lisp
trunk/projects/bos/worldpay-test/boi-handlers.lisp
trunk/projects/bos/worldpay-test/map-handlers.lisp
trunk/projects/bos/worldpay-test/packages.lisp
trunk/projects/bos/worldpay-test/reports-xml-handler.lisp
trunk/projects/bos/worldpay-test/tags.lisp
Log:
SBCL compatibility changes.
Modified: trunk/projects/bos/m2/bitmap.lisp
===================================================================
--- trunk/projects/bos/m2/bitmap.lisp 2006-12-03 10:46:55 UTC (rev 2097)
+++ trunk/projects/bos/m2/bitmap.lisp 2006-12-03 10:47:39 UTC (rev 2098)
@@ -150,7 +150,7 @@
:first-name "Otto"
:last-name "Mustermann"
:email-address "otto.mustermann at t-online.de"))))
- (flet ((step ()
+ (flet ((make-one-contract ()
(let* ((limit 0.0001)
(n (max 1 (round (/ 0.5 (+ (random (- 1.0 limit)) limit))))))
@@ -159,9 +159,9 @@
(make-contract u n))))
(if limit
(dotimes (x limit)
- (step))
+ (make-one-contract))
(loop
- (step)))))))
+ (make-one-contract)))))))
#+(or)
(progn
Modified: trunk/projects/bos/m2/m2.lisp
===================================================================
--- trunk/projects/bos/m2/m2.lisp 2006-12-03 10:46:55 UTC (rev 2097)
+++ trunk/projects/bos/m2/m2.lisp 2006-12-03 10:47:39 UTC (rev 2098)
@@ -388,7 +388,9 @@
(excl:delete-directory-and-files pathname)
#+cmu
(unix:unix-rmdir (ext:unix-namestring pathname))
- #-(or allegro cmu)
+ #+sbcl
+ (sb-posix:rmdir (namestring pathname))
+ #-(or allegro cmu sbcl)
...))
(defun reinit (&key delete directory website-url)
Modified: trunk/projects/bos/m2/packages.lisp
===================================================================
--- trunk/projects/bos/m2/packages.lisp 2006-12-03 10:46:55 UTC (rev 2097)
+++ trunk/projects/bos/m2/packages.lisp 2006-12-03 10:47:39 UTC (rev 2098)
@@ -189,6 +189,13 @@
#:*cert-download-directory*))
(defpackage :bos.m2.cert-generator
- (:use :cl :extensions :bos.m2.config :bknr.utils :cl-ppcre :cl-interpol :cl-gd)
+ (:use :cl
+ #+cmu :extensions
+ #+sbcl :sb-ext
+ :bos.m2.config
+ :bknr.utils
+ :cl-ppcre
+ :cl-interpol
+ :cl-gd)
(:shadowing-import-from :cl-interpol #:quote-meta-chars)
(:export #:cert-daemon))
Modified: trunk/projects/bos/worldpay-test/boi-handlers.lisp
===================================================================
--- trunk/projects/bos/worldpay-test/boi-handlers.lisp 2006-12-03 10:46:55 UTC (rev 2097)
+++ trunk/projects/bos/worldpay-test/boi-handlers.lisp 2006-12-03 10:47:39 UTC (rev 2098)
@@ -3,6 +3,8 @@
(enable-interpol-syntax)
+(defvar *xml-sink*)
+
(defmacro with-xml-response (req &body body)
`(with-http-response (,req *ent* :content-type "text/xml")
(with-query-params (,req download)
@@ -16,6 +18,7 @@
, at body))))))
(defmacro with-xml-error-handler (req &body body)
+ (declare (ignore req))
`(handler-case
(progn , at body)
(error (e)
Modified: trunk/projects/bos/worldpay-test/map-handlers.lisp
===================================================================
--- trunk/projects/bos/worldpay-test/map-handlers.lisp 2006-12-03 10:46:55 UTC (rev 2097)
+++ trunk/projects/bos/worldpay-test/map-handlers.lisp 2006-12-03 10:47:39 UTC (rev 2098)
@@ -54,6 +54,7 @@
(defmethod object-handler-get-object ((handler image-tile-handler) req)
(destructuring-bind (x y &rest operations) (decoded-handler-path handler req)
+ (declare (ignore operations))
(setf x (parse-integer x))
(setf y (parse-integer y))
(ensure-map-tile x y)))
Modified: trunk/projects/bos/worldpay-test/packages.lisp
===================================================================
--- trunk/projects/bos/worldpay-test/packages.lisp 2006-12-03 10:46:55 UTC (rev 2097)
+++ trunk/projects/bos/worldpay-test/packages.lisp 2006-12-03 10:47:39 UTC (rev 2098)
@@ -3,7 +3,8 @@
(defpackage :worldpay-test
(:use :cl
:date-calc
- :extensions
+ #+cmu :extensions
+ #+sbcl :sb-ext
:cl-user
:cl-interpol
:cl-ppcre
@@ -14,7 +15,6 @@
:puri
#+(or) :mime
:acl-compat.socket
- :acl-compat.mp
:bknr.web
:bknr.datastore
:bknr.indices
Modified: trunk/projects/bos/worldpay-test/reports-xml-handler.lisp
===================================================================
--- trunk/projects/bos/worldpay-test/reports-xml-handler.lisp 2006-12-03 10:46:55 UTC (rev 2097)
+++ trunk/projects/bos/worldpay-test/reports-xml-handler.lisp 2006-12-03 10:47:39 UTC (rev 2098)
@@ -16,6 +16,7 @@
(defun contract-year (contract)
(multiple-value-bind (second minute hour date month year day-of-week is-dst tz) (decode-universal-time (contract-date contract))
+ (declare (ignore second minute hour date month day-of-week is-dst tz))
year))
(defmethod handle ((handler reports-xml-handler) req)
@@ -48,6 +49,7 @@
(defun week-of-contract (contract)
"Return Week key (YYYY-WW) for given contract."
(multiple-value-bind (second minute hour date month year day-of-week is-dst tz) (decode-universal-time (contract-date contract))
+ (declare (ignore second minute hour day-of-week is-dst tz))
(multiple-value-bind (week-no week-year)
(week-of-year year month date)
(when (and (> week-no 50)
@@ -61,6 +63,7 @@
(defun week-first-yday (contract)
"Return the day-of year of the first day of the contract's date"
(multiple-value-bind (second minute hour date month year day-of-week is-dst tz) (decode-universal-time (contract-date contract))
+ (declare (ignore second minute hour day-of-week is-dst tz))
(max 0 (- (day-of-year year month date) (day-of-week year month date)))))
(defreport contracts-by-week ()
Modified: trunk/projects/bos/worldpay-test/tags.lisp
===================================================================
--- trunk/projects/bos/worldpay-test/tags.lisp 2006-12-03 10:46:55 UTC (rev 2097)
+++ trunk/projects/bos/worldpay-test/tags.lisp 2006-12-03 10:47:39 UTC (rev 2098)
@@ -6,7 +6,7 @@
;; das ist fuer WPDISPLAY
(let ((s (cxml::chained-handler *html-sink*)))
(cxml::maybe-close-tag s)
- (map nil (lambda (c) (cxml::write-rune (char-code c) s)) str)))
+ (map nil (lambda (c) (cxml::write-rune #+sbcl c #+cmu (char-code c) s)) str)))
(defun language-options-1 (current-language)
(loop for (language-symbol language-name) in (website-languages)
More information about the Bknr-cvs
mailing list