diff --git a/Makefile.am b/Makefile.am index cdb033f..ef9dafe 100644 --- a/Makefile.am +++ b/Makefile.am @@ -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)" diff --git a/Makefile.in b/Makefile.in index de48908..ca9b16a 100644 --- a/Makefile.in +++ b/Makefile.in @@ -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)" diff --git a/src/complete.lisp b/src/complete.lisp index 6891778..f2c7efe 100644 --- a/src/complete.lisp +++ b/src/complete.lisp @@ -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)))))) diff --git a/src/filesystem-utils.lisp b/src/filesystem-utils.lisp index 799d8a5..629dfe6 100644 --- a/src/filesystem-utils.lisp +++ b/src/filesystem-utils.lisp @@ -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)))) diff --git a/src/misc-utils.lisp b/src/misc-utils.lisp index b8f9dee..c9a8a0c 100644 --- a/src/misc-utils.lisp +++ b/src/misc-utils.lisp @@ -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) diff --git a/src/package.lisp b/src/package.lisp index 94d1742..b953945 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -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