src/parse/html-parser.lisp

   1 (in-package :closure-html)
   2
   3 ;;; FIXME: I liked the old SLURP-CATALOG code better than the LOOP below.
   4 ;;; (Except for the use of NETLIB and URI, which we don't have here.)
   5
   6 #||
   7
   8 (defun slurp-catalog (catalog-url)
   9   ;; Really dirty implementation
  10   (setf *simple-catalog* nil)
  11   (multiple-value-bind (io header) (netlib::open-document-2 catalog-url)
  12     (declare (ignore header))
  13     (unwind-protect
  14         (let ((str (glisp::gstream-as-string io)))
  15           (with-input-from-string (input str)
  16             (do ((x (read input nil nil) (read input nil nil)))
  17                 ((null x))
  18               (assert (equal (symbol-name x) "PUBLIC"))
  19               (let ((name (read input))
  20                     (file (read input)))
  21                 (assert (stringp name))
  22                 (assert (stringp file))
  23                 (push (cons name (url:merge-url (url:parse-url file) catalog-url))
  24                       *simple-catalog*)))))
  25       (g/close io))))
  26
  27 (format T "~&;; Parsing DTD~% ")
  28 (sgml:slurp-catalog (url:parse-url "file://closure/resources/dtd/catalog"))
  29 (setf cl-user::*html-dtd* (sgml:parse-dtd '(:public "-//W3C//DTD HTML 4.0 Frameset//EN")))
  30 (format T "~&;; done~%")
  31
  32 ||#
  33
  34 (defparameter sgml::*simple-catalog*
  35   (let ((base
  36          (merge-pathnames
  37           "resources/"
  38           (asdf:component-relative-pathname
  39            (asdf:find-system :closure-html)))))
  40     (loop
  41        :for (name . filename)
  42        :in '(("-//W3O//DTD W3 HTML 3.0//EN" . "dtd/HTML-3.0")
  43              ("NETSCAPE-Bookmark-file-1" . "dtd/NETSCAPE-Bookmark-file-1")
  44              ("-//W3C//ENTITIES Special//EN//HTML" . "dtd/Entities-Special")
  45              ("-//W3C//ENTITIES Symbols//EN//HTML" . "dtd/Entities-Symbols")
  46              ("-//W3C//ENTITIES Latin1//EN//HTML" . "dtd/Entities-Latin1")
  47              ("-//W3C//DTD HTML 4.0 Frameset//EN" . "dtd/DTD-HTML-4.0-Frameset")
  48              ("-//W3C//DTD HTML 4.0//EN" . "dtd/DTD-HTML-4.0")
  49              ("-//W3C//DTD HTML 4.0 Transitional//EN" . "dtd/DTD-HTML-4.0-Transitional"))
  50        :collect (cons name (merge-pathnames filename base)))))
  51
  52 (defparameter *html-dtd*
  53   (sgml:parse-dtd '(:public "-//W3C//DTD HTML 4.0 Frameset//EN")))
  54
  55 (defun parse (inputstr)
  56   "given a string, produce a sgml:pt, which would be your toplevel parse tree node"
  57   (let ((dtd *html-dtd*))
  58     (let ((input (runes:make-xstream
  59                   (flexi-streams:make-in-memory-input-stream
  60                    (flexi-streams:string-to-octets
  61                     inputstr :external-format (flexi-streams:make-external-format :utf-8))))))
  62       (setf (sgml::a-stream-scratch input)
  63             (make-array #.(* 2 4096) :element-type 'runes:rune))
  64       (sgml::setup-code-vector input :utf-8)
  65       (let ((r (sgml:sgml-parse dtd input)))
  66         (sgml::post-mortem-heuristic dtd r)))))