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 ,@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@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) + ,@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@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 (,,@temps) + ,,@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) ,@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 ,@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@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) - ,@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@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 (,,@temps) - ,,@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) ,@body)) \ No newline at end of file