feat(common-lisp): add project loading and testing commands

Doing so manually in a Sly REPL is otherwise time consuming and
repetitive.

modules/lang/common-lisp/autoload/common-lisp.el

@@ -17,3 +17,65 @@
                         ((> attempt 5) (error "Failed to start Slynk process."))
                         (t (recurse (1+ attempt))))))
       (recurse 1))))
+
+;;;###autoload
+(defun +lisp/load-project-systems ()
+  "Load all systems of the current Lisp project into Sly."
+  (interactive)
+  (thread-last (+lisp--project-asd-file)
+               (+lisp--systems-from-asd)
+               (mapcar (lambda (s) (format ":%s" s)))
+               (funcall (lambda (ss) (string-join ss " ")))
+               (format "(ql:quickload '(%s))")
+               (sly-interactive-eval)))
+
+(defun +lisp--project-asd-file ()
+  "Yield an absolute file path to the current project's `.asd' file."
+  (let* ((proot (doom-project-root))
+         (files (doom-files-in proot :depth 1 :match "[.]asd$")))
+    (pcase files
+      ('() (error "No .asd file found in: %s" proot))
+      (`(,asdf) asdf)
+      (_ (error "Too many .asd files found in : %s" proot)))))
+
+(defun +lisp--systems-from-asd (asdf)
+  "Given a path to an ASDF project definition, extract the names of
+the systems defined therein."
+  (let ((file (doom-file-read asdf))
+        (patt "defsystem \"\\([a-z-/]+\\)"))
+    (when (not (string-match patt file))
+      (error "No systems defined in: %s" asdf))
+    (thread-last (s-match-strings-all patt file)
+                 (mapcar #'cl-second))))
+
+;; TODO Get this to run in a comint buffer?
+;;;###autoload
+(defun +lisp/test-system ()
+  "Run `asdf:test-system' on the selected system of the current project."
+  (interactive)
+  (thread-last (+lisp--project-asd-file)
+               (+lisp--systems-from-asd)
+               (completing-read "Test which Lisp system?")
+               (format "(asdf:test-system :%s)")
+               (sly-interactive-eval)))
+
+;;;###autoload
+(defun +lisp/reload-project ()
+  "Restart the Sly session and reload the current project."
+  (interactive)
+  (sly-restart-inferior-lisp)
+  (cl-labels ((recurse (attempt)
+                (sleep-for 1)
+                (condition-case nil
+                    (sly-eval "PONG")
+                  (error (if (= 5 attempt)
+                             (error "Failed to reload Lisp project in 5 attempts.")
+                           (recurse (1+ attempt)))))))
+    (recurse 1)
+    (+lisp/load-project-systems)))
+
+;;;###autoload
+(defun +lisp/find-file-in-quicklisp ()
+  "Find a file belonging to a library downloaded by Quicklisp."
+  (interactive)
+  (doom-project-find-file "~/.quicklisp/dists/"))

modules/lang/common-lisp/config.el

@@ -94,9 +94,10 @@
 
         (:localleader
          :map lisp-mode-map
-         :desc "Sly"          "'" #'sly
-         :desc "Sly (ask)"    ";" (cmd!! #'sly '-)
-         :desc "Expand macro" "m" #'macrostep-expand
+         :desc "Sly"                       "'" #'sly
+         :desc "Sly (ask)"                 ";" (cmd!! #'sly '-)
+         :desc "Expand macro"              "m" #'macrostep-expand
+         :desc "Find local Quicklisp file" "f" #'+lisp/find-file-in-quicklisp
          (:prefix ("c" . "compile")
           :desc "Compile file"          "c" #'sly-compile-file
           :desc "Compile/load file"     "C" #'sly-compile-and-load-file
@@ -136,8 +137,10 @@
           :desc "Who sets"                "S" #'sly-who-sets)
          (:prefix ("r" . "repl")
           :desc "Clear REPL"         "c" #'sly-mrepl-clear-repl
+          :desc "Load Project"       "l" #'+lisp/load-project-systems
           :desc "Quit connection"    "q" #'sly-quit-lisp
           :desc "Restart connection" "r" #'sly-restart-inferior-lisp
+          :desc "Reload Project"     "R" #'+lisp/reload-project
           :desc "Sync REPL"          "s" #'sly-mrepl-sync)
          (:prefix ("s" . "stickers")
           :desc "Toggle breaking stickers" "b" #'sly-stickers-toggle-break-on-stickers
@@ -146,7 +149,9 @@
           :desc "Fetch stickers"           "f" #'sly-stickers-fetch
           :desc "Replay stickers"          "r" #'sly-stickers-replay
           :desc "Add/remove sticker"       "s" #'sly-stickers-dwim)
-         (:prefix ("t" . "trace")
+         (:prefix ("t" . "test")
+          :desc "Test System" "s" #'+lisp/test-system)
+         (:prefix ("T" . "trace")
           :desc "Toggle"         "t" #'sly-toggle-trace-fdefinition
           :desc "Toggle (fancy)" "T" #'sly-toggle-fancy-trace
           :desc "Untrace all"    "u" #'sly-untrace-all)))