blob: ce7fb33abff1dd131103e3ced9184de03f4142aa (
plain) (
blame)
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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
|
diff --git a/src/parse/sgml-dtd.lisp b/src/parse/sgml-dtd.lisp
index de774c0..dbee852 100644
--- a/src/parse/sgml-dtd.lisp
+++ b/src/parse/sgml-dtd.lisp
@@ -624,73 +624,6 @@
(return))))
classes))
-;;;; ----------------------------------------------------------------------------------------------------
-;;;; Compiled DTDs
-;;;;
-
-;; Since parsing and 'compiling' DTDs is slow, I'll provide for a way
-;; to (un)dump compiled DTD to stream.
-
-(defun dump-dtd (dtd sink)
- (let ((*print-pretty* nil)
- (*print-readably* t)
- (*print-circle* t))
- (princ "#." sink)
- (prin1
- `(MAKE-DTD :NAME ',(dtd-name dtd)
- :ELEMENTS (LET ((R (MAKE-HASH-TABLE :TEST #'EQ)))
- (SETF ,@(let ((q nil))
- (maphash (lambda (key value)
- (push `',value q)
- (push `(GETHASH ',key R) q))
- (dtd-elements dtd))
- q))
- R)
- :ENTITIES ',(dtd-entities dtd)
- :RESOLVE-INFO (LET ((R (MAKE-HASH-TABLE :TEST #'EQUAL)))
- (SETF ,@(let ((q nil))
- (maphash (lambda (key value)
- (push `',value q)
- (push `(GETHASH ',key R) q))
- (dtd-resolve-info dtd))
- q))
- R)
- ;; XXX surclusion-cache fehlt
- )
- sink)))
-
-;;XXX
-(defun save-html-dtd ()
- (with-open-file (sink "html-dtd.lisp" :direction :output :if-exists :new-version)
- (print `(in-package :sgml) sink)
- (let ((*package* (find-package :sgml)))
- (princ "(SETQ " sink)
- (prin1 'cl-user::*html-dtd* sink)
- (princ " '" sink)
- (dump-dtd cl-user::*html-dtd* sink)
- (princ ")" sink))))
-
-;;; --------------------------------------------------------------------------------
-;;; dumping DTDs
-
-
-(defun dump-dtd (dtd filename)
- (let ((*foo* dtd))
- (declare (special *foo*))
- (with-open-file (sink (merge-pathnames filename "*.lisp")
- :direction :output
- :if-exists :new-version)
- (format sink "(in-package :sgml)(locally (declare (special *foo*))(setq *foo* '#.*foo*))"))
- (compile-file (merge-pathnames filename "*.lisp"))))
-
-(defun undump-dtd (filename)
- (let (*foo*)
- (declare (special *foo*))
- (load (compile-file-pathname (merge-pathnames filename "*.lisp"))
- :verbose nil
- :print nil)
- *foo*))
-
(defmethod make-load-form ((self dtd) &optional env)
(declare (ignore env))
`(make-dtd :name ',(dtd-name self)
|
