mirror of https://codeberg.org/cage/tinmop/
- 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:
parent
4d65bc200a
commit
fd91165752
|
@ -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)"
|
||||
|
|
|
@ -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)"
|
||||
|
|
|
@ -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))))))
|
||||
|
||||
|
|
|
@ -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))))
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue