diff --git a/modules/lang/common-lisp/autoload/common-lisp.el b/modules/lang/common-lisp/autoload/common-lisp.el index 255e1cc19..33cc28ef1 100644 --- a/modules/lang/common-lisp/autoload/common-lisp.el +++ b/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/")) diff --git a/modules/lang/common-lisp/config.el b/modules/lang/common-lisp/config.el index d1c66b20a..f773627cb 100644 --- a/modules/lang/common-lisp/config.el +++ b/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)))