about summary refs log tree commit diff
path: root/third_party/lisp/closure-html
diff options
context:
space:
mode:
Diffstat (limited to 'third_party/lisp/closure-html')
-rw-r--r--third_party/lisp/closure-html/default.nix65
-rw-r--r--third_party/lisp/closure-html/dtds-from-store.patch16
-rw-r--r--third_party/lisp/closure-html/no-double-defun.patch78
3 files changed, 159 insertions, 0 deletions
diff --git a/third_party/lisp/closure-html/default.nix b/third_party/lisp/closure-html/default.nix
new file mode 100644
index 000000000000..1886ea2ec9a2
--- /dev/null
+++ b/third_party/lisp/closure-html/default.nix
@@ -0,0 +1,65 @@
+{ depot, pkgs, ... }:
+
+let
+  src = pkgs.applyPatches {
+    name = "closure-html-source";
+    src = pkgs.lispPackages.closure-html.src;
+
+    patches = [
+      # delete unexported and unused double defun in sgml-dtd.lisp
+      # which reference undefined CL-USER:*HTML-DTD* (!) which
+      # unlike CLOSURE-HTML:*HTML-DTD* is not involved in the
+      # packages operation.
+      ./no-double-defun.patch
+      # Patches html-parser.lisp to look for the distributed
+      # dtd files and catalog in this source derivations out
+      # path in the nix store instead of the same directory
+      # relatively to the (built) system.
+      ./dtds-from-store.patch
+    ];
+
+    postPatch = ''
+      # Inject file which defines CLOSURE-HTML:*HTML-DTD*
+      # early in the package's build since SBCL otherwise
+      # fails due to the undefined variable. Need to inject
+      # this via postPatch since using a nix file results
+      # in failure to look up the file's true name which
+      # is done for … reasons, apparently.
+      cat > src/define-html-dtd.lisp << EOF
+      (in-package :closure-html)
+      (defvar *html-dtd*)
+      EOF
+
+      # Substitute reference to @out@ of this source
+      # directory in this patched file.
+      substituteAllInPlace src/parse/html-parser.lisp
+    '';
+  };
+
+  getSrcs = builtins.map (p: "${src}/${p}");
+in
+
+depot.nix.buildLisp.library {
+  name = "closure-html";
+
+  srcs = getSrcs [
+    "src/defpack.lisp"
+    "src/define-html-dtd.lisp"
+    "src/glisp/util.lisp"
+    "src/util/clex.lisp"
+    "src/util/lalr.lisp"
+    "src/net/mime.lisp"
+    "src/parse/pt.lisp"
+    "src/parse/sgml-dtd.lisp"
+    "src/parse/sgml-parse.lisp"
+    "src/parse/html-parser.lisp"
+    "src/parse/lhtml.lisp"
+    "src/parse/unparse.lisp"
+    "src/parse/documentation.lisp"
+  ];
+
+  deps = [
+    depot.third_party.lisp.flexi-streams
+    depot.third_party.lisp.closure-common
+  ];
+}
diff --git a/third_party/lisp/closure-html/dtds-from-store.patch b/third_party/lisp/closure-html/dtds-from-store.patch
new file mode 100644
index 000000000000..a9ffd8085e89
--- /dev/null
+++ b/third_party/lisp/closure-html/dtds-from-store.patch
@@ -0,0 +1,16 @@
+diff --git a/src/parse/html-parser.lisp b/src/parse/html-parser.lisp
+index 4e45b81..5025a26 100644
+--- a/src/parse/html-parser.lisp
++++ b/src/parse/html-parser.lisp
+@@ -36,10 +36,7 @@
+         (make-pathname
+ 	 :name nil
+ 	 :type nil
+-	 :defaults (merge-pathnames
+-		    "resources/"
+-		    (asdf:component-relative-pathname
+-		     (asdf:find-system :closure-html))))))
++	 :defaults "@out@/resources/")))
+     (loop
+        :for (name . filename)
+        :in '(("-//W3O//DTD W3 HTML 3.0//EN" . "dtd/HTML-3.0")
diff --git a/third_party/lisp/closure-html/no-double-defun.patch b/third_party/lisp/closure-html/no-double-defun.patch
new file mode 100644
index 000000000000..ce7fb33abff1
--- /dev/null
+++ b/third_party/lisp/closure-html/no-double-defun.patch
@@ -0,0 +1,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)