50 lines
1.4 KiB
Common Lisp
50 lines
1.4 KiB
Common Lisp
;;;; CLASH --- The Common Lisp Adaptable Simple HTTP server
|
|
;;;; This is copyrighted software. See documentation for terms.
|
|
;;;;
|
|
;;;; readtable.cl --- Specialized Syntax/Readtable for CLASH
|
|
;;;;
|
|
;;;; $Id$
|
|
|
|
(cl: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)
|
|
(declare (ignore 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)
|
|
(declare (ignore 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*)))
|