cage
/
tinmop
mirror of https://codeberg.org/cage/tinmop/
1
0
Fork 0
Code Issues

- fixed file completion in the command window.

This commit is contained in:
cage 2023-11-18 11:23:46 +01:00
parent d01b6c798f
commit 4866606d5f
2 changed files with 21 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/command-window.lisp
View File

@ -340,8 +340,7 @@ be either `:keybinding' or `:string'. the former for key command the latter for
(setf suggestions-win (complete-window:init))) (setf suggestions-win (complete-window:init)))
(win-show suggestions-win) (win-show suggestions-win)
(multiple-value-bind (candidates common-prefix) (multiple-value-bind (candidates common-prefix)
(suggestions-window:update-suggestions suggestions-win (suggestions-window:update-suggestions suggestions-win command-line)
command-line)
(if candidates (if candidates
(if (null common-prefix) (if (null common-prefix)
(progn (progn
@ -456,8 +455,9 @@ be either `:keybinding' or `:string'. the former for key command the latter for
(command-line command-line)) win (command-line command-line)) win
(when suggestions-win (when suggestions-win
(let ((suggestion (suggested-selection win))) (let ((suggestion (suggested-selection win)))
(setf command-line suggestion) (when (string-not-empty-p suggestion)
(move-point-to-end win command-line)))) (setf command-line suggestion)
(move-point-to-end win command-line)))))
win) win)
(defun fire-user-input-event (win) (defun fire-user-input-event (win)

29
src/complete.lisp
View File

@ -38,9 +38,10 @@ See: complete:directory-complete")
(defun reduce-to-common-prefix (items) (defun reduce-to-common-prefix (items)
(reduce #'text-utils:common-prefix items)) (reduce #'text-utils:common-prefix items))
(defun pathname-directory-pathname (pathname) (defun pathname->directory-pathname (pathname)
"convenience function to make a pathname object to a directory" "convenience function to make a pathname object to a directory"
(make-pathname :name nil :type nil (make-pathname :name nil
:type nil
:defaults pathname)) :defaults pathname))
(defun underlying-directory-p (pathname) (defun underlying-directory-p (pathname)
@ -78,21 +79,25 @@ to the appropriate home directory."
"Return two values completion of 'string' (non nil if can be "Return two values completion of 'string' (non nil if can be
completed) and the common prefix of the completion string." completed) and the common prefix of the completion string."
(when (text-utils:string-not-empty-p string) (when (text-utils:string-not-empty-p string)
(let* ((string (tilde-expand-string string)) (let* ((namestring (tilde-expand-string string))
(dir (pathname-directory-pathname string)) (name-dir (if (file-exists-p namestring)
(namefun (if (relative-pathname-p string) (fs:parent-dir-path namestring)
#'namestring namestring))
(lambda (x) (namestring (merge-pathnames x)))))) (dir (pathname->directory-pathname namestring))
(namefun (if (relative-pathname-p string)
#'namestring
(lambda (x) (namestring (merge-pathnames x))))))
(unless (and (underlying-directory-p dir) (unless (and (underlying-directory-p dir)
(not (wild-pathname-p dir))) (not (wild-pathname-p dir)))
(return-from directory-complete (values nil 0))) (return-from directory-complete (values nil 0)))
(with-directory-iterator (next dir) (with-directory-iterator (next dir)
(when-let* ((all (loop (when-let* ((all (loop
for entry = (next) for entry = (next)
while entry collect while entry collect
(funcall namefun entry))) (funcall namefun entry)))
(candidates (sort (remove-if-not (lambda (a) (candidates (sort (remove-if-not (lambda (a)
(text-utils:string-starts-with-p string a)) (text-utils:string-starts-with-p name-dir
a))
all) all)
(lambda (a b) (< (length a) (lambda (a b) (< (length a)
(length b)))))) (length b))))))