[bknr-cvs] hans changed trunk/thirdparty/hunchentoot/
BKNR Commits
bknr at bknr.net
Thu Feb 12 09:04:52 UTC 2009
Revision: 4244
Author: hans
URL: http://bknr.net/trac/changeset/4244
Compilation fixes for non-Lispworks. Compiles, but does not run yet.
A trunk/thirdparty/hunchentoot/compat.lisp
U trunk/thirdparty/hunchentoot/hunchentoot.asd
U trunk/thirdparty/hunchentoot/session.lisp
U trunk/thirdparty/hunchentoot/util.lisp
Added: trunk/thirdparty/hunchentoot/compat.lisp
===================================================================
--- trunk/thirdparty/hunchentoot/compat.lisp (rev 0)
+++ trunk/thirdparty/hunchentoot/compat.lisp 2009-02-12 09:04:52 UTC (rev 4244)
@@ -0,0 +1,114 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10 -*-
+;;; $Header: /usr/local/cvsrep/hunchentoot/util.lisp,v 1.35 2008/04/08 14:39:18 edi Exp $
+
+;;; Copyright (c) 2004-2009, Dr. Edmund Weitz. All rights reserved.
+
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+
+;;; * Redistributions of source code must retain the above copyright
+;;; notice, this list of conditions and the following disclaimer.
+
+;;; * Redistributions in binary form must reproduce the above
+;;; copyright notice, this list of conditions and the following
+;;; disclaimer in the documentation and/or other materials
+;;; provided with the distribution.
+
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(in-package :hunchentoot)
+
+(defmacro when-let ((var form) &body body)
+ "Evaluates FORM and binds VAR to the result, then executes BODY
+if VAR has a true value."
+ `(let ((,var ,form))
+ (when ,var , at body)))
+
+(defmacro with-unique-names ((&rest bindings) &body body)
+ "Syntax: WITH-UNIQUE-NAMES ( { var | (var x) }* ) declaration* form*
+
+Executes a series of forms with each VAR bound to a fresh,
+uninterned symbol. The uninterned symbol is as if returned by a call
+to GENSYM with the string denoted by X - or, if X is not supplied, the
+string denoted by VAR - as argument.
+
+The variable bindings created are lexical unless special declarations
+are specified. The scopes of the name bindings and declarations do not
+include the Xs.
+
+The forms are evaluated in order, and the values of all but the last
+are discarded \(that is, the body is an implicit PROGN)."
+ ;; reference implementation posted to comp.lang.lisp as
+ ;; <cy3bshuf30f.fsf at ljosa.com> by Vebjorn Ljosa - see also
+ ;; <http://www.cliki.net/Common%20Lisp%20Utilities>
+ `(let ,(mapcar #'(lambda (binding)
+ (check-type binding (or cons symbol))
+ (if (consp binding)
+ (destructuring-bind (var x) binding
+ (check-type var symbol)
+ `(,var (gensym ,(etypecase x
+ (symbol (symbol-name x))
+ (character (string x))
+ (string x)))))
+ `(,binding (gensym ,(symbol-name binding)))))
+ bindings)
+ , at body))
+
+(defmacro with-rebinding (bindings &body body)
+ "Syntax: WITH-REBINDING ( { var | (var prefix) }* ) form*
+
+Evaluates a series of forms in the lexical environment that is
+formed by adding the binding of each VAR to a fresh, uninterned
+symbol, and the binding of that fresh, uninterned symbol to VAR's
+original value, i.e., its value in the current lexical environment.
+
+The uninterned symbol is created as if by a call to GENSYM with the
+string denoted by PREFIX - or, if PREFIX is not supplied, the string
+denoted by VAR - as argument.
+
+The forms are evaluated in order, and the values of all but the last
+are discarded \(that is, the body is an implicit PROGN)."
+ ;; reference implementation posted to comp.lang.lisp as
+ ;; <cy3wv0fya0p.fsf at ljosa.com> by Vebjorn Ljosa - see also
+ ;; <http://www.cliki.net/Common%20Lisp%20Utilities>
+ (loop for binding in bindings
+ for var = (if (consp binding) (car binding) binding)
+ for name = (gensym)
+ collect `(,name ,var) into renames
+ collect ``(,,var ,,name) into temps
+ finally (return `(let ,renames
+ (with-unique-names ,bindings
+ `(let (,, at temps)
+ ,, at body))))))
+
+(defun get-peer-address-and-port (socket)
+ "Returns the peer address and port of the socket SOCKET as two
+values. The address is returned as a string in dotted IP address
+notation."
+ (values (usocket:vector-quad-to-dotted-quad (usocket:get-peer-address socket))
+ (usocket:get-peer-port socket)))
+
+(defun make-socket-stream (socket server)
+ "Returns a stream for the socket SOCKET. The SERVER argument is
+ignored."
+ (declare (ignore server))
+ (usocket:socket-stream socket))
+
+(defun make-lock (name)
+ "Simple wrapper to allow LispWorks and Bordeaux Threads to coexist."
+ (bt:make-lock name))
+
+(defmacro with-lock-held ((lock) &body body)
+ "Simple wrapper to allow LispWorks and Bordeaux Threads to coexist."
+ `(bt:with-lock-held (,lock) , at body))
\ No newline at end of file
Modified: trunk/thirdparty/hunchentoot/hunchentoot.asd
===================================================================
--- trunk/thirdparty/hunchentoot/hunchentoot.asd 2009-02-11 23:54:40 UTC (rev 4243)
+++ trunk/thirdparty/hunchentoot/hunchentoot.asd 2009-02-12 09:04:52 UTC (rev 4244)
@@ -63,6 +63,8 @@
(:file "packages")
#+:lispworks
(:file "lispworks")
+ #-:lispworks
+ (:file "compat")
(:file "specials")
(:file "conditions")
(:file "mime-types")
Modified: trunk/thirdparty/hunchentoot/session.lisp
===================================================================
--- trunk/thirdparty/hunchentoot/session.lisp 2009-02-11 23:54:40 UTC (rev 4243)
+++ trunk/thirdparty/hunchentoot/session.lisp 2009-02-12 09:04:52 UTC (rev 4244)
@@ -29,7 +29,7 @@
(in-package :hunchentoot)
-(defgeneric session-db-lock (acceptor &key (whole-db-p t))
+(defgeneric session-db-lock (acceptor &key whole-db-p)
(:documentation "A function which returns a lock that will be used
to prevent concurrent access to sessions. The first argument will be
the acceptor that handles the current request, the second argument is
Modified: trunk/thirdparty/hunchentoot/util.lisp
===================================================================
--- trunk/thirdparty/hunchentoot/util.lisp 2009-02-11 23:54:40 UTC (rev 4243)
+++ trunk/thirdparty/hunchentoot/util.lisp 2009-02-12 09:04:52 UTC (rev 4244)
@@ -29,72 +29,7 @@
(in-package :hunchentoot)
-#-:lispworks
-(defmacro when-let ((var form) &body body)
- "Evaluates FORM and binds VAR to the result, then executes BODY
-if VAR has a true value."
- `(let ((,var ,form))
- (when ,var , at body)))
-#-:lispworks
-(defmacro with-unique-names ((&rest bindings) &body body)
- "Syntax: WITH-UNIQUE-NAMES ( { var | (var x) }* ) declaration* form*
-
-Executes a series of forms with each VAR bound to a fresh,
-uninterned symbol. The uninterned symbol is as if returned by a call
-to GENSYM with the string denoted by X - or, if X is not supplied, the
-string denoted by VAR - as argument.
-
-The variable bindings created are lexical unless special declarations
-are specified. The scopes of the name bindings and declarations do not
-include the Xs.
-
-The forms are evaluated in order, and the values of all but the last
-are discarded \(that is, the body is an implicit PROGN)."
- ;; reference implementation posted to comp.lang.lisp as
- ;; <cy3bshuf30f.fsf at ljosa.com> by Vebjorn Ljosa - see also
- ;; <http://www.cliki.net/Common%20Lisp%20Utilities>
- `(let ,(mapcar #'(lambda (binding)
- (check-type binding (or cons symbol))
- (if (consp binding)
- (destructuring-bind (var x) binding
- (check-type var symbol)
- `(,var (gensym ,(etypecase x
- (symbol (symbol-name x))
- (character (string x))
- (string x)))))
- `(,binding (gensym ,(symbol-name binding)))))
- bindings)
- , at body))
-
-#-:lispworks
-(defmacro with-rebinding (bindings &body body)
- "Syntax: WITH-REBINDING ( { var | (var prefix) }* ) form*
-
-Evaluates a series of forms in the lexical environment that is
-formed by adding the binding of each VAR to a fresh, uninterned
-symbol, and the binding of that fresh, uninterned symbol to VAR's
-original value, i.e., its value in the current lexical environment.
-
-The uninterned symbol is created as if by a call to GENSYM with the
-string denoted by PREFIX - or, if PREFIX is not supplied, the string
-denoted by VAR - as argument.
-
-The forms are evaluated in order, and the values of all but the last
-are discarded \(that is, the body is an implicit PROGN)."
- ;; reference implementation posted to comp.lang.lisp as
- ;; <cy3wv0fya0p.fsf at ljosa.com> by Vebjorn Ljosa - see also
- ;; <http://www.cliki.net/Common%20Lisp%20Utilities>
- (loop for binding in bindings
- for var = (if (consp binding) (car binding) binding)
- for name = (gensym)
- collect `(,name ,var) into renames
- collect ``(,,var ,,name) into temps
- finally (return `(let ,renames
- (with-unique-names ,bindings
- `(let (,, at temps)
- ,, at body))))))
-
(defun starts-with-p (seq subseq &key (test 'eql))
"Tests whether the sequence SEQ starts with the sequence
SUBSEQ. Individual elements are compared with TEST."
@@ -385,27 +320,3 @@
"Whether the current connection to the client is secure."
(acceptor-ssl-p acceptor))
-#-:lispworks
-(defun get-peer-address-and-port (socket)
- "Returns the peer address and port of the socket SOCKET as two
-values. The address is returned as a string in dotted IP address
-notation."
- (values (usocket:vector-quad-to-dotted-quad (usocket:get-peer-address socket))
- (usocket:get-peer-port socket)))
-
-#-:lispworks
-(defun make-socket-stream (socket server)
- "Returns a stream for the socket SOCKET. The SERVER argument is
-ignored."
- (declare (ignore server))
- (usocket:socket-stream socket))
-
-#-:lispworks
-(defun make-lock (name)
- "Simple wrapper to allow LispWorks and Bordeaux Threads to coexist."
- (bt:make-lock name))
-
-#-:lispworks
-(defmacro with-lock-held ((lock) &body body)
- "Simple wrapper to allow LispWorks and Bordeaux Threads to coexist."
- `(bt:with-lock-held (,lock) , at body))
\ No newline at end of file
More information about the Bknr-cvs
mailing list