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."