New package HAX.
* closure-common.asd: Added hax.lisp * hax.lisp: New.
This commit is contained in:
@ -53,5 +53,5 @@
|
||||
#-x&y-streams-are-stream (:file "xstream")
|
||||
#-x&y-streams-are-stream (:file "ystream")
|
||||
#+x&y-streams-are-stream (:file #+scl "stream-scl")
|
||||
)
|
||||
(:file "hax"))
|
||||
:depends-on (#-scl :trivial-gray-streams))
|
||||
|
||||
131
hax.lisp
Normal file
131
hax.lisp
Normal file
@ -0,0 +1,131 @@
|
||||
;;; -*- show-trailing-whitespace: t; indent-tabs: nil -*-
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; Title: An event API for the HTML parser, inspired by SAX
|
||||
;;; Created: 2007-10-14
|
||||
;;; Author: David Lichteblau
|
||||
;;; License: BSD
|
||||
;;; ---------------------------------------------------------------------------
|
||||
;;; (c) copyright 2005,2007 David Lichteblau
|
||||
|
||||
;;; Redistribution and use in source and binary forms, with or without
|
||||
;;; modification, are permitted provided that the following conditions are
|
||||
;;; met:
|
||||
;;;
|
||||
;;; 1. Redistributions of source code must retain the above copyright
|
||||
;;; notice, this list of conditions and the following disclaimer.
|
||||
;;;
|
||||
;;; 2. 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 ``AS IS'' AND ANY EXPRESS 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 OR CONTRIBUTORS 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.
|
||||
|
||||
(defpackage :hax
|
||||
(:use :common-lisp)
|
||||
(:export #:abstract-handler
|
||||
#:default-handler
|
||||
|
||||
#:make-attribute
|
||||
#:standard-attribute
|
||||
#:find-attribute
|
||||
#:attribute-name
|
||||
#:attribute-value
|
||||
#:attribute-specified-p
|
||||
|
||||
#:start-document
|
||||
#:start-element
|
||||
#:characters
|
||||
#:end-element
|
||||
#:end-document
|
||||
#:comment))
|
||||
|
||||
(in-package :hax)
|
||||
|
||||
|
||||
;;;; ATTRIBUTE
|
||||
|
||||
(defgeneric attribute-name (attribute))
|
||||
(defgeneric attribute-value (attribute))
|
||||
(defgeneric attribute-specified-p (attribute))
|
||||
|
||||
(defclass standard-attribute ()
|
||||
((name :initarg :name :accessor attribute-name)
|
||||
(value :initarg :value :accessor attribute-value)
|
||||
(specified-p :initarg :specified-p :accessor attribute-specified-p)))
|
||||
|
||||
(defun make-attribute (name value &optional (specified-p t))
|
||||
(make-instance 'standard-attribute
|
||||
:name name
|
||||
:value value
|
||||
:specified-p specified-p))
|
||||
|
||||
(defun %rod= (x y)
|
||||
;; allow rods *and* strings *and* null
|
||||
(cond
|
||||
((zerop (length x)) (zerop (length y)))
|
||||
((zerop (length y)) nil)
|
||||
((stringp x) (string= x y))
|
||||
(t (runes:rod= x y))))
|
||||
|
||||
(defun find-attribute (name attrs)
|
||||
(find name attrs :key #'attribute-name :test #'%rod=))
|
||||
|
||||
|
||||
;;;; ABSTRACT-HANDLER and DEFAULT-HANDLER
|
||||
|
||||
(defclass abstract-handler () ())
|
||||
(defclass default-handler (abstract-handler) ())
|
||||
|
||||
(defgeneric start-document (handler name public-id system-id)
|
||||
(:method ((handler null) name public-id system-id)
|
||||
(declare (ignore name public-id system-id))
|
||||
nil)
|
||||
(:method ((handler default-handler) name public-id system-id)
|
||||
(declare (ignore name public-id system-id))
|
||||
nil))
|
||||
|
||||
(defgeneric start-element (handler name attributes)
|
||||
(:method ((handler null) name attributes)
|
||||
(declare (ignore name attributes))
|
||||
nil)
|
||||
(:method ((handler default-handler) name attributes)
|
||||
(declare (ignore name attributes))
|
||||
nil))
|
||||
|
||||
(defgeneric characters (handler data)
|
||||
(:method ((handler null) data)
|
||||
(declare (ignore data))
|
||||
nil)
|
||||
(:method ((handler default-handler) data)
|
||||
(declare (ignore data))
|
||||
nil))
|
||||
|
||||
(defgeneric end-element (handler name)
|
||||
(:method ((handler null) name)
|
||||
(declare (ignore name))
|
||||
nil)
|
||||
(:method ((handler default-handler) name)
|
||||
(declare (ignore name))
|
||||
nil))
|
||||
|
||||
(defgeneric end-document (handler)
|
||||
(:method ((handler null)) nil)
|
||||
(:method ((handler default-handler)) nil))
|
||||
|
||||
(defgeneric comment (handler data)
|
||||
(:method ((handler null) data)
|
||||
(declare (ignore data))
|
||||
nil)
|
||||
(:method ((handler default-handler) data)
|
||||
(declare (ignore data))
|
||||
nil))
|
||||
Reference in New Issue
Block a user