implement local-project-searcher

lisp/extend-quicklisp.lisp

@@ -61,8 +61,38 @@
        (eval `(asdf:defsystem ,system-name :depends-on (,name))))
      (asdf:find-system system-name))))
 
+(defun local-project-enum (path)
+  (let ((sub (remove-if (lambda (x)
+                          (eql (aref x 0) #\.))
+                        (uiop:subdirectories path)
+                        :key (lambda (x) (first(last (pathname-directory x)))))))
+    (apply #'append 
+           (remove-if-not (lambda(x)
+                            (equal (pathname-type x) "asd"))
+                          (uiop:directory-files path))
+           (mapcar (lambda (x)
+                     (local-project-enum x))
+                   sub))))
+
+(defvar *local-project-cache* nil)
+(defun local-project-build-hash (&key rebuild)
+  (if (or (not *local-project-cache*)
+          rebuild)
+      (let ((hash (make-hash-table :test 'equal)))
+        (dolist (system-directory (reverse *local-project-directory*))
+          (dolist (asd (local-project-enum system-directory))
+            (setf (gethash (pathname-name asd) hash) asd)))
+        (setf *local-project-cache* hash))
+      *local-project-cache*))
+
 (defun local-projects-searcher (system-name)
-  )
+  (let ((path (gethash system-name (local-project-build-hash))))
+    (when path
+      (if (probe-file path)
+          path
+          (progn
+            (local-project-build-hash :rebuild t)
+            (local-projects-searcher system-name))))))
 
 (unless (find 'roswell-installable-searcher (symbol-value (read-from-string "asdf:*system-definition-search-functions*")))
   (set (read-from-string "asdf:*system-definition-search-functions*")

lisp/init.lisp

@@ -28,7 +28,8 @@ have the latest asdf, and this file has a workaround for this.
   (:shadow :load :eval :package :restart :print :write)
   (:export :run :*argv* :*main* :*load* :*cmd* :quit :script :quicklisp :getenv :opt
            :ignore-shebang :asdf :include :ensure-asdf :revert-extension
-           :roswell :exec :setenv :unsetenv :version :swank :verbose :*init-hook*)
+           :roswell :exec :setenv :unsetenv :version :swank :verbose :*init-hook*
+           :*local-project-directory*)
   (:documentation "Roswell backend."))
 
 (in-package :roswell)
@@ -38,6 +39,7 @@ have the latest asdf, and this file has a workaround for this.
 (defparameter *main* nil)
 (defvar *cmd* nil)
 (defparameter *load* `((identity . cl:load)))
+(defvar *local-project-directory* nil)
 
 ;; small tools
 (defun getenv (x)

lisp/util.lisp

@@ -1,7 +1,7 @@
 (roswell:include () "util")
 (defpackage :roswell.util
   (:use :cl)
-  (:import-from :ros :opt :ensure-asdf)
+  (:import-from :ros :opt :ensure-asdf :*local-project-directory*)
   (:export
    :uname :uname-m :homedir :config :impl :which :config-env :checkoutdir
    :parse-version-spec :download :expand :sh :chdir :system :module