feat(3p/lisp/closure-html): init at 2017-04-19

This one requires a bit of jumping through hoops. Patching the dtd /
catalog lookup is quite straightforward and similar to cxml, but the
CLOSURE-HTML:*html-dtd* variable gives us a bit of trouble: It is
defined quite late in `html-parser.lisp`, but files that need to be
built first already reference it. SBCL has apparently decided to be
particular about this and emits a `WARNING` (!) condition for this
which is also worthy of `failure-p` of `compile-file` being true,
so that `buildLisp` will abort compilation. We workaround this issue
by injecting an extra source file which `defvar`s the desired symbol.

A similar issue exists with `dump-dtd` which references
`CL-USER:*HTML-DTD*` for some reason. Since this is a helper intended
for development (?) and not exported we just throw it away via a
patch.

Change-Id: Ic0f92815a21f3793925c49a70a72f4a86791efe4
Reviewed-on: https://cl.tvl.fyi/c/depot/+/3263
Tested-by: BuildkiteCI
Reviewed-by: grfn <grfn@gws.fyi>
This commit is contained in:
sterni 2021-08-01 15:03:40 +02:00
parent 281c09fae7
commit 70e5783e22
3 changed files with 166 additions and 0 deletions

View file

@ -0,0 +1,72 @@
{ depot, pkgs, ... }:
let
src = pkgs.applyPatches {
name = "closure-html-source";
src = pkgs.fetchFromGitHub {
owner = "bluelisp";
repo = "closure-html";
rev = "fee42604ae36884d2f7c5e8ffc3441fdb8ec77b7"; # 2017-04-19
sha256 = "105vm29qnxh6zj3rh4jwpm8dyp3b9bsva64c8a78cr270p28d032";
};
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 [
"closure-html.asd"
"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.nix.buildLisp.bundled "asdf")
depot.third_party.lisp.flexi-streams
depot.third_party.lisp.closure-common
];
}

View file

@ -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")

View file

@ -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)