feat(common-lisp): use sly-asdf

This allows us to offload system loading and testing to a third-party
library.
This commit is contained in:
Colin Woodbury 2023-12-31 23:44:29 +09:00 committed by Henrik Lissner
parent c1516edd66
commit 2853982447
3 changed files with 10 additions and 45 deletions

View file

@ -18,50 +18,9 @@
(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."
"Restart the Sly session and reload a chosen system."
(interactive)
(sly-restart-inferior-lisp)
(cl-labels ((recurse (attempt)
@ -72,7 +31,7 @@ the systems defined therein."
(error "Failed to reload Lisp project in 5 attempts.")
(recurse (1+ attempt)))))))
(recurse 1)
(+lisp/load-project-systems)))
(sly-asdf-load-system)))
;;;###autoload
(defun +lisp/find-file-in-quicklisp ()