(defvar *loadable-systems* nil
  "Cached list of ASDF loadable packages. Set to NIL to recompute.")

(defvar *loadable-system-table* nil
  "Cached table of ASDF loadable packages. Set to NIL to recompute.")

(defun asdf-systems-in-directory (dir &key as-strings)
  "Return a list of systems in ‘dir’. If ‘as-strings’ is true, return them as
strings, otherwise as keywords."
  (loop :with base :and result
     :for f :in (glob (path-append dir "*.[Aa][Ss][Dd]"))
     :do (spin)
     :collect
     (progn
       (setf base (path-file-name f)
	     result (subseq base 0 (- (length base) 4)))
       (if as-strings
	   result
	   (keywordify result)))))

(defun add-asdf-directory (directory)
  "Add directory to the list of loadable systems and the cache if it exists."
  (when directory
    (let ((new-systems (asdf-systems-in-directory directory)))
      (when new-systems
	(setf *loadable-systems*
	      (append new-systems *loadable-systems*))
	(when *loadable-system-table*
	  (loop :for sys :in new-systems :do
	    (setf (gethash sys *loadable-system-table*) t)))))))

;; This is an horrible hack. I wish we could ask ASDF and Quicklisp.
(defun loadable-systems (&key as-strings)
  "List of potentially ASDF loadable systems."
  (labels ((place-dir (p)
	     "Resolve place into a directory."
	     (with-output-to-string (s)
	       (if (listp p)
		   (loop :for e :in p
		      :if (eq e :home)
		      :do (write-string
			   (namestring (user-homedir-pathname)) s)
		      :else
		      :do (write-string e s))
		   (write-string p s)))))
    (or (and *loadable-systems*
	     (or (and (and as-strings (every #'stringp *loadable-systems*))
		      *loadable-systems*)
		 (and (not as-strings) (every #'keywordp *loadable-systems*)
		      *loadable-systems*)))
	(setf *loadable-systems*
	      (with-spin ()
		(let ((s-dirs (loop :for e in asdf:*source-registry-parameter*
				 :if (and (listp e) (eq (car e) :directory))
				 :collect (place-dir (cadr e))))
		      (c-dirs (mapcar #'namestring asdf:*central-registry*)))
		  (append
		   (loop :for d :in (concatenate 'list s-dirs c-dirs)
		      :append
		      (asdf-systems-in-directory d :as-strings as-strings))
		   #+quicklisp
		   ;; Quicklisp
		   (loop :for d :in (ql-dist:all-dists)
		      :append
		      (loop :for s :in (ql-dist:installed-systems d)
			 :do (spin)
			 :collect
			 (if as-strings
			     (ql-dist:name s)
			     (keywordify (ql-dist:name s))))))))))))

(defvar *quickloadable-systems* nil
  "Cached list of Quickload loadable systems. Set to NIL to recompute.")

(defun quickloadable-systems (&key as-strings)
  "List of packages the quickload can maybe load, if it can download them."
  #-quicklisp (declare (ignore as-strings))
  (or *quickloadable-systems*
      #+quicklisp
      (setf *quickloadable-systems*
	    (with-spin ()
	      (loop :for d :in (ql-dist:all-dists)
		 :append
		 (loop :for s :in (ql-dist:provided-systems d)
		    :do (spin)
		    :collect
		    (if as-strings
			(string-downcase (ql-dist:name s))
			(keywordify (ql-dist:name s)))))))))

(defun ensure-loadable-systems-table ()
  "If it doesn't already exist, populate the *loadable-system-table* from the
loadable-systems function."
  (when (not *loadable-system-table*)
    (setf *loadable-system-table* (make-hash-table :test 'equal))
    (loop :for p :in (loadable-systems :as-strings t)
	  :do (setf (gethash p *loadable-system-table*) t))
    *loadable-system-table*))

(defun loadable-system-p (system-designator)
  "Return true if SYSTEM-DESIGNATOR denotes a loadable system."
  (ensure-loadable-systems-table)
  (gethash (string system-designator) *loadable-system-table*))

(defun clear-loadable-system-cache ()
  "This should be done whenever packages are added or removed or the search
configuration is changed."
  (setf *loadable-systems* nil
	*loadable-system-table* nil
	*quickloadable-systems* nil))