From 5ccb71725725ce0a84c7d4cc8a9af1d1945a3f30 Mon Sep 17 00:00:00 2001
From: David Lichteblau <david@lichteblau.com>
Date: Sun, 7 Oct 2007 21:20:03 +0200
Subject: [PATCH] Closure re-integration.

	* src/defpack.lisp (CLOSURE-HTML): Export *html-dtd*.
	(CLOSURE-MIME-TYPES): Export find-mime-type-from-extension,
	mime-type-name, mime-type-equal.  (SGML): Export PT.

	* src/parse/html-parser.lisp: Add the old slurp-catalog as a
	comment for restauration at a later time.

	* src/parse/sgml-parse.lisp:
	s/cl-user::*html-dtd*/closure-html::*html-dtd*/
---
 src/defpack.lisp           |  9 +++++++--
 src/parse/html-parser.lisp | 31 +++++++++++++++++++++++++++++++
 src/parse/sgml-parse.lisp  | 16 ++++++++--------
 3 files changed, 46 insertions(+), 10 deletions(-)

diff --git a/src/defpack.lisp b/src/defpack.lisp
index 29c6d25..4bf50a5 100644
--- a/src/defpack.lisp
+++ b/src/defpack.lisp
@@ -29,7 +29,8 @@
 
 (defpackage :closure-html
   (:use :cl)
-  (:export #:parse))
+  (:export #:*html-dtd*
+	   #:parse))
 
 (defpackage :html-glisp
   (:use :cl)
@@ -72,11 +73,15 @@
   (:use :cl :html-glisp ;; white-space-p
         )
   (:export #:parse-mime-content-type    ;### yet to be defined
-           #:find-mime-type))
+	   #:find-mime-type-from-extension
+	   #:mime-type-name
+           #:find-mime-type
+	   #:mime-type-equal))
 
 (defpackage :sgml
   (:use :cl :html-glisp :runes)
   (:export #:SGML-PARSE 
+	   #:PT
            #:PPT 
            #:SGML-UNPARSE 
            #:PARSE-DTD
diff --git a/src/parse/html-parser.lisp b/src/parse/html-parser.lisp
index 3ac675e..2a281f0 100644
--- a/src/parse/html-parser.lisp
+++ b/src/parse/html-parser.lisp
@@ -1,5 +1,36 @@
 (in-package :closure-html)
 
+;;; FIXME: I liked the old SLURP-CATALOG code better than the LOOP below.
+;;; (Except for the use of NETLIB and URI, which we don't have here.)
+
+#||
+
+(defun slurp-catalog (catalog-url)
+  ;; Really dirty implementation
+  (setf *simple-catalog* nil)
+  (multiple-value-bind (io header) (netlib::open-document-2 catalog-url)
+    (declare (ignore header))
+    (unwind-protect
+        (let ((str (glisp::gstream-as-string io)))
+          (with-input-from-string (input str)
+            (do ((x (read input nil nil) (read input nil nil)))
+                ((null x))
+              (assert (equal (symbol-name x) "PUBLIC"))
+              (let ((name (read input))
+                    (file (read input)))
+                (assert (stringp name))
+                (assert (stringp file))
+                (push (cons name (url:merge-url (url:parse-url file) catalog-url))
+                      *simple-catalog*)))))
+      (g/close io))))
+
+(format T "~&;; Parsing DTD~% ")
+(sgml:slurp-catalog (url:parse-url "file://closure/resources/dtd/catalog"))
+(setf cl-user::*html-dtd* (sgml:parse-dtd '(:public "-//W3C//DTD HTML 4.0 Frameset//EN")))
+(format T "~&;; done~%")
+
+||#
+
 (defparameter sgml::*simple-catalog*
   (let ((base
 	 (merge-pathnames
diff --git a/src/parse/sgml-parse.lisp b/src/parse/sgml-parse.lisp
index c9e37db..5dc9007 100644
--- a/src/parse/sgml-parse.lisp
+++ b/src/parse/sgml-parse.lisp
@@ -1301,7 +1301,7 @@
         neu))))
 
 (defun parse-html (input &optional (charset :iso-8859-1))
-  (let ((dtd cl-user::*html-dtd*))
+  (let ((dtd closure-html:*html-dtd*))
     (let ((input (runes:make-xstream input :initial-speed 1 :speed 128)))
       (setf (a-stream-scratch input)
         (make-array #.(* 2 *buf-size*) :element-type 'rune))
@@ -1613,7 +1613,7 @@
     (parse-html input)))
 ||#
 
-(defun check-saneness (pt &optional (dtd cl-user::*html-dtd*))
+(defun check-saneness (pt &optional (dtd closure-html:*html-dtd*))
   (dolist (k (pt-children pt))
     (unless (member (gi k) (elm-inclusion dtd (gi pt)))
       (warn "Unallowed ~A element within ~A." (gi k) (gi pt)))
@@ -1707,7 +1707,7 @@
   (with-open-file (sink "/tmp/t.html" 
                    :direction :output
                    :if-exists :new-version)
-    (let ((dtd cl-user::*html-dtd*))
+    (let ((dtd closure-html:*html-dtd*))
       (let ((p (shortest-path dtd :BODY offending)))
         (let ((p2 (shortest-path dtd offending :PCDATA)))
           (format sink "~A<BR>~%" offending)
@@ -1734,9 +1734,9 @@
 
 (defun bluu ()
   (let ((i 0))
-    (dolist (off (all-elms cl-user::*html-dtd*))
-      (cond (t '(or (member :B (elm-inclusion cl-user::*html-dtd* off))
-                 (member :P (elm-inclusion cl-user::*html-dtd* off)))
+    (dolist (off (all-elms closure-html:*html-dtd*))
+      (cond (t '(or (member :B (elm-inclusion closure-html:*html-dtd* off))
+                 (member :P (elm-inclusion closure-html:*html-dtd* off)))
              (blah off)
              (format T "~&;; ~A" off)
              (open-in-netscape "file:/tmp/t.html")
@@ -1746,7 +1746,7 @@
              (sleep 1))
             (t
              (format T "~&;; Skipping ~A, because inclusion is ~A."
-                     off (elm-inclusion cl-user::*html-dtd* off)))))))
+                     off (elm-inclusion closure-html:*html-dtd* off)))))))
 ||#
 
 (defun equivalence-classes (prediate set)
@@ -1783,7 +1783,7 @@
 
 #||
 (defun bloo ()
-  (let ((dtd cl-user::*html-dtd*))
+  (let ((dtd closure-html:*html-dtd*))
     (equivalence-classes (lambda (x y)
                            (and (set-equal (elm-inclusion dtd x) (elm-inclusion dtd y))
                                 (set-equal (elm-surclusion dtd x) (elm-surclusion dtd y))))
-- 
2.11.4.GIT