79 lines
3 KiB
Diff
79 lines
3 KiB
Diff
|
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)
|