From 57583b37ce0c5b220d25acbf3527c2f4547242d3 Mon Sep 17 00:00:00 2001 From: "Pierre R. Mai" Date: Wed, 7 Feb 2001 13:31:29 +0000 Subject: [PATCH] Various fixes to case-dependent code, in order to allow CLASH to work with Allegro CL in "modern" mode. Although we don't think that "modern" mode is the correct approach to case-sensitivity in CL, the changes we made should also make it easier to work in ANSI-compliant implementations/modes, with all the settings for readtable-case. Note though that this is a first best effort attempt, and so further case-ification bugs might still remain. YMMV. --- CLASH.system | 14 +++++++------- src/main/conditions.cl | 2 +- src/main/status-codes.cl | 34 +++++++++++++++++----------------- src/main/url.cl | 4 ++-- src/package.cl | 6 +++--- src/utility.cl | 4 ++++ 6 files changed, 34 insertions(+), 30 deletions(-) diff --git a/CLASH.system b/CLASH.system index a5d6ae8..f1ae2b0 100644 --- a/CLASH.system +++ b/CLASH.system @@ -7,7 +7,7 @@ ;;;; Checkout Tag: $Name$ ;;;; $Id$ -(in-package :MAKE) +(in-package :make) ;;;; %File Description: ;;;; @@ -25,11 +25,11 @@ :source-pathname "" :components ((:file "package") (:file "utility" :depends-on ("package")) - #+CMU + #+cmu (:file "cmu-locking" :depends-on ("package")) - #+LISPWORKS4.1 + #+lispworks4.1 (:file "lwl-locking" :depends-on ("package")) - #+ALLEGRO + #+allegro (:file "acl-locking" :depends-on ("package")))) (:module "main" :source-pathname "main" @@ -79,10 +79,10 @@ :depends-on ("base")) (:module "driver" :source-pathname "drivers" - :components (#+CMU + :components (#+cmu (:file "simple-cmu") - #+LISPWORKS4.1 + #+lispworks4.1 (:file "simple-lwl") - #+ALLEGRO + #+allegro (:file "simple-acl")) :depends-on ("base" "main")))) diff --git a/src/main/conditions.cl b/src/main/conditions.cl index 504e958..2fe1624 100644 --- a/src/main/conditions.cl +++ b/src/main/conditions.cl @@ -21,7 +21,7 @@ "CLASH error: ~?~& Possible HTTP status code: ~D (~A)." fmt args (clash-error-code condition) - (HTTP-code-description (clash-error-code condition)))) + (HTTP-Code-Description (clash-error-code condition)))) (define-condition clash-error (error) ((code :initarg :code :initform +HTTP-Code-Internal-Server-Error+ diff --git a/src/main/status-codes.cl b/src/main/status-codes.cl index b082995..5e8f5c5 100644 --- a/src/main/status-codes.cl +++ b/src/main/status-codes.cl @@ -575,23 +575,23 @@ (defconstant +HTTP-Code-Symbols+ - '(+HTTP-CODE-NO-CONTENT+ +HTTP-CODE-GATEWAY-TIMEOUT+ - +HTTP-CODE-REQUEST-URI-TOO-LONG+ +HTTP-CODE-NON-AUTHORITATIVE-INFORMATION+ - +HTTP-CODE-USE-PROXY+ +HTTP-CODE-SERVICE-UNAVAILABLE+ - +HTTP-CODE-BAD-REQUEST+ +HTTP-CODE-MULTIPLE-CHOICES+ - +HTTP-CODE-SWITCHING-PROTOCOLS+ +HTTP-CODE-CREATED+ +HTTP-CODE-UNAUTHORIZED+ - +HTTP-CODE-BAD-GATEWAY+ +HTTP-CODE-FORBIDDEN+ +HTTP-CODE-CONFLICT+ - +HTTP-CODE-CONTINUE+ +HTTP-CODE-INTERNAL-SERVER-ERROR+ - +HTTP-CODE-RESET-CONTENT+ +HTTP-CODE-PRECONDITION-FAILED+ - +HTTP-CODE-UNSUPPORTED-MEDIA-TYPE+ +HTTP-CODE-OK+ - +HTTP-CODE-METHOD-NOT-ALLOWED+ +HTTP-CODE-LENGTH-REQUIRED+ - +HTTP-CODE-REQUEST-ENTITY-TOO-LARGE+ +HTTP-CODE-MOVED-TEMPORARILY+ - +HTTP-CODE-NOT-FOUND+ +HTTP-CODE-NOT-MODIFIED+ - +HTTP-CODE-HTTP-VERSION-NOT-SUPPORTED+ +HTTP-CODE-PARTIAL-CONTENT+ - +HTTP-CODE-PAYMENT-REQUIRED+ +HTTP-CODE-PROXY-AUTHENTICATION-REQUIRED+ - +HTTP-CODE-ACCEPTED+ +HTTP-CODE-NOT-ACCEPTABLE+ - +HTTP-CODE-MOVED-PERMANENTLY+ +HTTP-CODE-REQUEST-TIMEOUT+ - +HTTP-CODE-NOT-IMPLEMENTED+ +HTTP-CODE-SEE-OTHER+ +HTTP-CODE-GONE+) + '(+HTTP-Code-No-Content+ +HTTP-Code-Gateway-Timeout+ + +HTTP-Code-Request-URI-Too-Long+ +HTTP-Code-Non-Authoritative-Information+ + +HTTP-Code-Use-Proxy+ +HTTP-Code-Service-Unavailable+ + +HTTP-Code-Bad-Request+ +HTTP-Code-Multiple-Choices+ + +HTTP-Code-Switching-Protocols+ +HTTP-Code-Created+ +HTTP-Code-Unauthorized+ + +HTTP-Code-Bad-Gateway+ +HTTP-Code-Forbidden+ +HTTP-Code-Conflict+ + +HTTP-Code-Continue+ +HTTP-Code-Internal-Server-Error+ + +HTTP-Code-Reset-Content+ +HTTP-Code-Precondition-Failed+ + +HTTP-Code-Unsupported-Media-Type+ +HTTP-Code-OK+ + +HTTP-Code-Method-Not-Allowed+ +HTTP-Code-Length-Required+ + +HTTP-Code-Request-Entity-Too-Large+ +HTTP-Code-Moved-Temporarily+ + +HTTP-Code-Not-Found+ +HTTP-Code-Not-Modified+ + +HTTP-Code-HTTP-Version-Not-Supported+ +HTTP-Code-Partial-Content+ + +HTTP-Code-Payment-Required+ +HTTP-Code-Proxy-Authentication-Required+ + +HTTP-Code-Accepted+ +HTTP-Code-Not-Acceptable+ + +HTTP-Code-Moved-Permanently+ +HTTP-Code-Request-Timeout+ + +HTTP-Code-Not-Implemented+ +HTTP-Code-See-Other+ +HTTP-Code-Gone+) "List of all HTTP-Code symbols.") (defun HTTP-Code-Description (code) diff --git a/src/main/url.cl b/src/main/url.cl index 3d05546..02c042d 100644 --- a/src/main/url.cl +++ b/src/main/url.cl @@ -127,8 +127,8 @@ indicates the presence of authority information.") (defmacro def-uri-char-p (name char &body body) "Declares an inlined predicate function on characters that is named -`URI-name-CHAR-P', has a lambda list of (char) and the body body." - (let ((realname (intern (format nil "URI-~A-CHAR-P" (symbol-name name)) +`uri-name-char-p', has a lambda list of (char) and the body body." + (let ((realname (intern (concatenate-symbol-names '#:uri- name '#:-char-p) (symbol-package name)))) `(progn (declaim (inline ,realname)) diff --git a/src/package.cl b/src/package.cl index 948bd6a..e4910a3 100644 --- a/src/package.cl +++ b/src/package.cl @@ -6,15 +6,15 @@ ;;;; Checkout Tag: $Name$ ;;;; $Id$ -(in-package :CL-USER) +(in-package :cl-user) ;;;; %File Description: ;;;; ;;;; ;;;; -(defpackage "CLASH" - (:use :CL #+(and :CMU :MP) :MP) +(defpackage :CLASH + (:use :cl #+(and :cmu :mp) :mp) (:export ;; Status Codes #:+HTTP-Code-Continue+ diff --git a/src/utility.cl b/src/utility.cl index 81a62fe..4a08d81 100644 --- a/src/utility.cl +++ b/src/utility.cl @@ -91,3 +91,7 @@ All other keywords work analogously to those for CL:POSITION." (funcall predicate x)) keys)) +;;; Symbol hacking stuff + +(defun concatenate-symbol-names (&rest symbols) + (apply #'concatenate 'string (mapcar #'symbol-name symbols)))