feat(sterni/clhs): add cli to lookup symbols in the CLHS r/2122

Probably very similar to M-x sly-hyperspec-lookup: take a list of
common lisp symbols on the command line open the corresponding pages
in a local copy of the hyperspec in $BROWSER. Optionally the paths can
be printed to stdout.

Change-Id: I389e254f14eb0fc8fd8b18a4dbfe7adeeda9ba72
Reviewed-on: https://cl.tvl.fyi/c/depot/+/2397
Tested-by: BuildkiteCI
Reviewed-by: sterni <sternenseemann@systemli.org>

4 files changed, 106 insertions, 0 deletions

diff --git a/users/sterni/clhs/README.md b/users/sterni/clhs/README.md
new file mode 100644
index 000000000000..1f42ff43a210
--- /dev/null
+++ b/users/sterni/clhs/README.md
@@ -0,0 +1,13 @@
+# clhs-lookup
+
+Simple cli to lookup symbols' documentation in a local copy of the
+Common Lisp HyperSpec.
+
+## usage
+
+```
+clhs-lookup [--print] symbol [symbol [...]]
+
+  --print  Print documentation paths to stdout instead of
+           opening them with $BROWSER (defaults to xdg-open).
+```
diff --git a/users/sterni/clhs/clhs-lookup.lisp b/users/sterni/clhs/clhs-lookup.lisp
new file mode 100644
index 000000000000..0e61dd901f93
--- /dev/null
+++ b/users/sterni/clhs/clhs-lookup.lisp
@@ -0,0 +1,46 @@
+(in-package :clhs-lookup)
+(declaim (optimize (safety 3)))
+
+(defun find-symbols-paths (syms clhs)
+  "Find pathnames to HyperSpec files describing the listed
+  symbol names (as strings). Paths are returned in the order
+  of the symbols given with missing entries removed."
+  (check-type syms list)
+  (check-type clhs pathname)
+  (let* ((data-dir (merge-pathnames "HyperSpec/Data/" clhs))
+         (data (merge-pathnames "Map_Sym.txt" data-dir))
+         (found (make-hash-table :test #'equal))
+         (syms (mapcar #'string-upcase syms)))
+  (with-open-file (s data :direction :input)
+    (loop
+      with missing    = syms
+      for symbol-line = (read-line s nil :eof)
+      for path-line   = (read-line s nil :eof)
+      until (or (eq symbol-line :eof)
+                (eq path-line   :eof)
+                (null missing))
+      for pos = (position symbol-line missing :test #'equal)
+      when pos
+      do (progn
+           (delete symbol-line missing)
+           (setf (gethash symbol-line found) path-line)))
+    ; TODO(sterni): get rid of Data/../ in path
+    (mapcar
+      (lambda (x) (merge-pathnames x data-dir))
+      (remove nil
+        (mapcar (lambda (x) (gethash x found)) syms))))))
+
+(defun main ()
+  (let* ((browser (or (uiop:getenvp "BROWSER") "xdg-open"))
+         (args    (uiop:command-line-arguments))
+         (prin    (member "--print" args :test #'equal))
+         (syms    (remove-if (lambda (x) (eq (char x 0) #\-)) args))
+         (paths (find-symbols-paths syms *clhs-path*)))
+      (if (null paths)
+        (uiop:quit 1)
+        (dolist (p paths)
+          (if prin
+            (format t "~A~%" p)
+            (uiop:launch-program
+              (format nil "~A ~A" browser p)
+              :force-shell t))))))
diff --git a/users/sterni/clhs/default.nix b/users/sterni/clhs/default.nix
new file mode 100644
index 000000000000..8c42e5e75c1f
--- /dev/null
+++ b/users/sterni/clhs/default.nix
@@ -0,0 +1,37 @@
+{ pkgs, depot, ... }:
+
+let
+  inherit (pkgs) fetchzip writeText;
+  inherit (depot.nix) buildLisp;
+  inherit (builtins) replaceStrings;
+
+  clhsVersion = "7-0";
+
+  clhs = fetchzip {
+    name = "HyperSpec-${replaceStrings [ "-" ] [ "." ] clhsVersion}";
+    url = "ftp://ftp.lispworks.com/pub/software_tools/reference/HyperSpec-${clhsVersion}.tar.gz";
+    sha256 = "1zsi35245m5sfb862ibzy0pzlph48wvlggnqanymhgqkpa1v20ak";
+    stripRoot = false;
+  };
+
+  clhs-path = writeText "clhs-path.lisp" ''
+    (in-package :clhs-lookup.clhs-path)
+    (defparameter *clhs-path* (pathname "${clhs}/"))
+  '';
+
+  clhs-lookup = buildLisp.program {
+    name = "clhs-lookup";
+
+    deps = [
+      (buildLisp.bundled "uiop")
+    ];
+
+    srcs = [
+      ./packages.lisp
+      clhs-path
+      ./clhs-lookup.lisp
+    ];
+  };
+in {
+  inherit clhs clhs-lookup;
+}
diff --git a/users/sterni/clhs/packages.lisp b/users/sterni/clhs/packages.lisp
new file mode 100644
index 000000000000..d059b96ce9f0
--- /dev/null
+++ b/users/sterni/clhs/packages.lisp
@@ -0,0 +1,10 @@
+(defpackage :clhs-lookup.clhs-path
+  (:use :cl)
+  (:export :*clhs-path*))
+
+(defpackage clhs-lookup
+  (:use :cl :uiop)
+  (:import-from :clhs-lookup.clhs-path :*clhs-path*)
+  (:export :main
+           :find-symbols-paths))
+