Commit fae0e857 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

Improve cl-source-registry-cache.lisp

* Don't recurse into a directory that has a .cl-source-registry.cache,
  but include the contents of the sub*directory's cache.
* Prefer *shorter* paths, not longer ones (!)
parent 7cc1540c
......@@ -14,18 +14,32 @@ To invalidate the cache, remove the cache file in the same directory:
(defun collect-asd (table asd)
(multiple-value-bind (previous foundp)
(gethash (pathname-name asd) table)
(when (or (not foundp) (< (length (pathname-directory previous))
(when (or (not foundp) (> (length (pathname-directory previous))
(length (pathname-directory asd))))
(setf (gethash (pathname-name asd) table) asd))))
(defun update-cache (directory)
(defun update-cache (directory &key (exclude *default-source-registry-exclusions*)
(recurse-beyond-asds *recurse-beyond-asds*))
(let* ((dir (ensure-pathname directory
:namestring :native
:ensure-absolute t :want-non-wild t :ensure-directory t
:want-existing t))
(table (make-hash-table :test 'equal)))
(collect-sub*directories-asd-files
dir :collect #'(lambda (asd) (collect-asd table asd)) :ignore-cache t)
(table (make-hash-table :test 'equal))
(collector #'(lambda (asd) (collect-asd table asd))))
(collect-sub*directories
dir
#'(lambda (d)
(if-let (cache (unless (equal d dir)
(probe-file* (subpathname d ".cl-source-registry.cache"))))
(destructuring-bind (tag &rest entries) (read-file-form cache)
(assert (eq tag :source-registry-cache))
(dolist (asd entries) (funcall collector (subpathname d asd)))
nil)
(let ((asds (collect-asds-in-directory d collector)))
(or recurse-beyond-asds (not asds)))))
#'(lambda (sub)
(not (member (car (last (pathname-directory sub))) exclude :test #'equal)))
(constantly nil))
(with-output-file (s (subpathname dir ".cl-source-registry.cache")
:if-exists :rename-and-delete :if-does-not-exist :create)
(format s "(:source-registry-cache~{~% ~S~})~%"
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment