Added some simple syntax/readtable enhancements to ease working with
URLs and HTTP-Versions. There will probably be further enhancements later on.
This commit is contained in:
@ -53,7 +53,9 @@
|
|||||||
:depends-on ("entity" "method"))
|
:depends-on ("entity" "method"))
|
||||||
(:file "server"
|
(:file "server"
|
||||||
:depends-on ("namespace" "messages"
|
:depends-on ("namespace" "messages"
|
||||||
"resource")))
|
"resource"))
|
||||||
|
(:file "readtable"
|
||||||
|
:depends-on ("url" "version")))
|
||||||
:depends-on ("base"))
|
:depends-on ("base"))
|
||||||
(:module "driver"
|
(:module "driver"
|
||||||
:source-pathname "drivers"
|
:source-pathname "drivers"
|
||||||
|
|||||||
48
src/main/readtable.cl
Normal file
48
src/main/readtable.cl
Normal file
@ -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*)))
|
||||||
Reference in New Issue
Block a user