changelog shortlog graph tags branches files raw help

Mercurial > core / changeset: find-skelfile fixes

changeset 410: c25d45ab1976
parent 409: 3e7d5e10eb42
child 411: 7e3c88fff062
author: Richard Westhaver <ellis@rwest.io>
date: Wed, 05 Jun 2024 21:12:23 -0400
files: lisp/lib/skel/core/util.lisp
description: find-skelfile fixes
     1.1--- a/lisp/lib/skel/core/util.lisp	Wed Jun 05 20:02:05 2024 -0400
     1.2+++ b/lisp/lib/skel/core/util.lisp	Wed Jun 05 21:12:23 2024 -0400
     1.3@@ -50,14 +50,17 @@
     1.4     "Load the 'skelfile' FILE."
     1.5     (load-ast (sk-read-file (make-instance 'sk-project) file)))
     1.6 
     1.7-  (defun find-sk-project-root (path name)
     1.8+  (defun probe-merge-file (name path)
     1.9+    (probe-file (merge-pathnames name path)))
    1.10+
    1.11+  (defun find-sk-project-root (path &optional (name *default-skelfile*))
    1.12     "Return the root location of a `skel-project' by checking for
    1.13   NAME."
    1.14-    (if (probe-file (merge-pathnames name path))
    1.15-        path
    1.16-        (let ((next (pathname-parent-directory-pathname path)))
    1.17-          (unless (uiop:pathname-equal next path)
    1.18-	    (find-sk-project-root next name)))))
    1.19+      (if (probe-merge-file path name)
    1.20+          path
    1.21+          (let ((next (pathname-parent-directory-pathname path)))
    1.22+            (unless (uiop:pathname-equal next path)
    1.23+	      (find-sk-project-root next name)))))
    1.24 
    1.25   (defun find-sk-file (path ext)
    1.26     "Return the next SK-FILE at PATH matching the extension EXT."
    1.27@@ -77,23 +80,31 @@
    1.28       (when cfg (setf sk (sk-install-user-config sk cfg)))
    1.29       (sk-write-file sk :path path :fmt fmt))))
    1.30 
    1.31-(defun find-skelfile (start &key (load nil) (filename *default-skelfile*) (walk t) error)
    1.32-  "Walk up the current directory returning the path to a 'skelfile', else
    1.33-return nil. When LOAD is non-nil, load the skelfile if found."
    1.34+(defun find-skelfile (start &key (load nil) (name *default-skelfile*) (ext "sk") (walk t) error)
    1.35+  "Walk up the current directory returning the path to a 'skelfile' by NAME or a
    1.36+filename with extension EXT, else return nil. When LOAD is non-nil, load the
    1.37+skelfile if found."
    1.38   ;; Check the current path, if no skelfile found, walk up a level and
    1.39   ;; continue until the `*skelfile-boundary*' is triggered.
    1.40-  (if walk 
    1.41-      (let ((root (find-sk-project-root (car (directory start)) filename)))
    1.42-	(if root
    1.43-	    (if load
    1.44-		(load-skelfile (merge-pathnames filename root))
    1.45-		(merge-pathnames filename root))
    1.46-	    (when error (error "failed to find root skelfile"))))
    1.47-      (if-let ((sk (probe-file (merge-pathnames filename start))))
    1.48-	(if load 
    1.49-	    (load-skelfile sk)
    1.50-	    sk)
    1.51-	(when error (error "failed to find root skelfile")))))
    1.52+  (labels ((%check (dir)
    1.53+             (or (probe-merge-file name dir)
    1.54+                 (when-let ((match (directory (merge-pathnames dir (format nil "*.~a" ext)))))
    1.55+                   (probe-file (car match)))
    1.56+                 (probe-merge-file (make-pathname :name name :type ext) dir)))
    1.57+           (%walk (dir)
    1.58+             (or (%check dir)
    1.59+                 (let ((next (pathname-parent-directory-pathname dir)))
    1.60+                   (if (uiop:pathname-equal next dir)
    1.61+                       (when error (error "failed to find root skelfile"))
    1.62+                       (%walk next)))))
    1.63+           (%load? (file) (if load (load-skelfile file) file)))
    1.64+    (setf start (car (directory start)))
    1.65+    (if-let ((match (%check start)))
    1.66+      (%load? match)
    1.67+      (if walk
    1.68+          (when-let ((match (%walk start)))
    1.69+            (%load? match))
    1.70+	  (when error (error "failed to find root skelfile"))))))
    1.71 
    1.72 (defun edit-skelrc ()
    1.73   "Open the current user configuration using ED."