diff --git a/CLASH.system b/CLASH.system index bbffac0..9db5fb6 100644 --- a/CLASH.system +++ b/CLASH.system @@ -53,7 +53,9 @@ :depends-on ("entity" "method")) (:file "server" :depends-on ("namespace" "messages" - "resource"))) + "resource")) + (:file "readtable" + :depends-on ("url" "version"))) :depends-on ("base")) (:module "driver" :source-pathname "drivers" diff --git a/src/main/readtable.cl b/src/main/readtable.cl new file mode 100644 index 0000000..eac71fe --- /dev/null +++ b/src/main/readtable.cl @@ -0,0 +1,48 @@ +;;;; CLASH --- The Common Lisp Adaptable Simple HTTP server +;;;; This is copyrighted software. See documentation for terms. +;;;; +;;;; readtable.cl --- Specialized Syntax/Readtable for CLASH +;;;; +;;;; Checkout Tag: $Name$ +;;;; $Id$ + +(in-package :CLASH) + +;;;; %File Description: +;;;; +;;;; This file provides a specialized syntax (via a new readtable) +;;;; that eases working with CLASH. +;;;; + +(defun add-clash-syntax-to-readtable (readtable) + "Modifies readtable to add all CLASH specific syntax." + ;; HTTP-Versions + (set-dispatch-macro-character #\# #\H + #'(lambda (stream subchar args) + (let ((data (read stream t nil t))) + (check-type data string) + (parse-http-version data))) + readtable) + ;; URL Parsing + (set-dispatch-macro-character #\# #\U + #'(lambda (stream subchar args) + (let ((data (read stream t nil t))) + (check-type data string) + (parse-url-from-string data))) + readtable) + readtable) + +(defvar *clash-readtable* + (add-clash-syntax-to-readtable (copy-readtable nil)) + "CLASH specific standard-readtable.") + +(defvar *saved-readtable* nil + "Saved readtable.") + +(defun enable-clash-syntax () + (unless (eq *readtable* *clash-readtable*) + (shiftf *saved-readtable* *readtable* *clash-readtable*))) + +(defun disable-clash-syntax () + (when (eq *readtable* *clash-readtable*) + (setq *readtable* *saved-readtable*)))