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)