1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
|
;;;; space-normalizer.lisp -- whitespace removal
;;;;
;;;; This file is part of the CXML parser, released under Lisp-LGPL.
;;;; See file COPYING for details.
;;;;
;;;; Copyright (c) 2005 David Lichteblau
(in-package :cxml)
(defclass whitespace-normalizer (sax-proxy)
((attributes :initform '(t) :accessor xml-space-attributes)
(models :initform nil :accessor xml-space-models)
(dtd :initarg :dtd :accessor xml-space-dtd)))
(defun make-whitespace-normalizer (chained-handler &optional dtd)
(make-instance 'whitespace-normalizer
:dtd dtd
:chained-handler chained-handler))
(defmethod sax::dtd ((handler whitespace-normalizer) dtd)
(unless (xml-space-dtd handler)
(setf (xml-space-dtd handler) dtd)))
(defmethod sax:start-element
((handler whitespace-normalizer) uri lname qname attrs)
(declare (ignore uri lname))
(let ((dtd (xml-space-dtd handler)))
(when dtd
(let ((xml-space
(sax:find-attribute (if (stringp qname) "xml:space" #"xml:space")
attrs)))
(push (if xml-space
(rod= (rod (sax:attribute-value xml-space)) #"default")
(car (xml-space-attributes handler)))
(xml-space-attributes handler)))
(let* ((e (cxml::find-element (rod qname) dtd))
(cspec (when e (cxml::elmdef-content e))))
(push (and (consp cspec)
(not (and (eq (car cspec) '*)
(let ((subspec (second cspec)))
(and (eq (car subspec) 'or)
(eq (cadr subspec) :PCDATA))))))
(xml-space-models handler)))))
(call-next-method))
(defmethod sax:characters ((handler whitespace-normalizer) data)
(cond
((and (xml-space-dtd handler)
(car (xml-space-attributes handler))
(car (xml-space-models handler)))
(unless (every #'white-space-rune-p (rod data))
(warn "non-whitespace character data in element content")
(call-next-method)))
(t
(call-next-method))))
(defmethod sax:end-element ((handler whitespace-normalizer) uri lname qname)
(declare (ignore uri lname qname))
(when (xml-space-dtd handler)
(pop (xml-space-attributes handler))
(pop (xml-space-models handler)))
(call-next-method))
|
