1
0
Fork 0

- fixed macro fs:do-directory;

- removed hardcoded string in Makefile;
- ensured 'fs:relative-file-path->absolute' adds a trailing slash when converting a directory path.
This commit is contained in:
cage 2024-04-21 18:49:55 +02:00
parent 4d65bc200a
commit fd91165752
6 changed files with 28 additions and 22 deletions

View File

@ -95,7 +95,8 @@ data/scripts/welcome-bot.lisp
dist_man1_MANS = doc/tinmop.man
$(PACKAGE): $(CONF_PATH_FILE) *.asd src/*
cd /usr/lib/sbcl/ && $(LISP_COMPILER) \
cd $$(dirname $$($(LISP_COMPILER) --noinform --eval "(format t \"~a\" *core-pathname*)" --eval "(sb-ext:quit)")) && \
$(LISP_COMPILER) \
--eval "(push \"$$(pwd)/\" asdf:*central-registry*)" \
--eval "(asdf:make '$(PACKAGE) :build-pathname \"../$(PACKAGE)\")" \
--eval "(uiop:quit)"

View File

@ -1117,7 +1117,8 @@ uninstall-man: uninstall-man1
$(PACKAGE): $(CONF_PATH_FILE) *.asd src/*
cd /usr/lib/sbcl/ && $(LISP_COMPILER) \
cd $$(dirname $$($(LISP_COMPILER) --noinform --eval "(format t \"~a\" *core-pathname*)" --eval "(sb-ext:quit)")) && \
$(LISP_COMPILER) \
--eval "(push \"$$(pwd)/\" asdf:*central-registry*)" \
--eval "(asdf:make '$(PACKAGE) :build-pathname \"../$(PACKAGE)\")" \
--eval "(uiop:quit)"

View File

@ -81,26 +81,21 @@ to the appropriate home directory."
"Return two values completion of 'string' (non nil if can be
completed) and the common prefix of the completion string."
(when (text-utils:string-not-empty-p string)
(let* ((namestring (tilde-expand-string string))
(let* ((namestring (fs:relative-file-path->absolute (tilde-expand-string string)))
(name-dir (if (fs:file-exists-p namestring)
(fs:parent-dir-path namestring)
namestring))
(dir (pathname->directory-pathname namestring))
(namefun (if (fs:relative-pathname-p string)
#'namestring
(lambda (x) (namestring (merge-pathnames x))))))
(dir (namestring (pathname->directory-pathname namestring)))
(absolute-dir-path (fs:relative-file-path->absolute dir)))
(unless (and (underlying-directory-p dir)
(not (wild-pathname-p dir)))
(return-from directory-complete (values nil 0)))
(format t "~a~%" dir)
(let* ((all (mapcar (lambda (a) (funcall namefun a))
(fs:collect-children dir)))
(let* ((all (fs:collect-children absolute-dir-path))
(candidates (sort (remove-if-not (lambda (a)
(text-utils:string-starts-with-p name-dir
a))
all)
(lambda (a b) (< (length a)
(length b))))))
#'string<)))
(values candidates
(reduce-to-common-prefix candidates))))))

View File

@ -194,23 +194,25 @@ symbolic link."
*directory-sep*))))
(defmacro do-directory ((var) root &body body)
(with-gensyms (dir dir-name new-path)
(with-gensyms (dir dir-name new-path dir-entry-ptr)
`(let ((,dir (nix:opendir ,root)))
(unwind-protect
(handler-case
(flet ((read-dir ()
(when-let* ((,dir-name (nix:dirent-name (nix:readdir ,dir)))
(,new-path (cat-parent-dir ,root ,dir-name)))
,new-path)))
(let ((,dir-entry-ptr (nix:readdir ,dir)))
(when (not (sb-alien:null-alien ,dir-entry-ptr))
(let* ((,dir-name (nix:dirent-name ,dir-entry-ptr))
(,new-path (cat-parent-dir ,root ,dir-name)))
,new-path)))))
(do ((,var (read-dir) (read-dir)))
((not ,var) ())
,@body))
(error () 0))
(error () nil))
(nix:closedir ,dir)))))
(defun collect-children (parent-dir)
(let ((all-paths '()))
(fs:do-directory (path) parent-dir
(do-directory (path) parent-dir
(if (or (backreference-dir-p path)
(loopback-reference-dir-p path))
(push path all-paths)
@ -306,10 +308,13 @@ symbolic link."
(resolved-path :pointer))
(defun relative-file-path->absolute (path)
(cffi:with-foreign-string (ptr-path path)
(let ((resolved ""))
(cffi:with-foreign-string (ptr-resolved resolved)
(ffi-realpath ptr-path ptr-resolved)))))
(let ((absolute-path (cffi:with-foreign-string (ptr-path path)
(let ((resolved ""))
(cffi:with-foreign-string (ptr-resolved resolved)
(ffi-realpath ptr-path ptr-resolved))))))
(if (dirp absolute-path)
(cat-parent-dir absolute-path *directory-sep*)
absolute-path)))
(defun regular-file-p (path)
(nix:s-isreg (nix:stat-mode (nix:stat path))))

View File

@ -933,6 +933,9 @@ to the array"
(definline make-null-pointer ()
(cffi:null-pointer))
(defun null-pointer-p (ptr)
(cffi:null-pointer-p ptr))
;; plugins, sort of
(defmacro with-load-forms-in-var ((special-var output-var file) &body body)

View File

@ -247,6 +247,7 @@
:gen-trivial-plist-gets
:gen-vec-comp
:make-null-pointer
:null-pointer-p
:with-load-forms-in-var
:time-unix->universal
:time-seconds-of