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

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

15
src/complete.lisp
View File

@ -38,9 +38,10 @@ See: complete:directory-complete")
(defun reduce-to-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"
(make-pathname :name nil :type nil
(make-pathname :name nil
:type nil
:defaults pathname))
(defun underlying-directory-p (pathname)
@ -78,8 +79,11 @@ 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* ((string (tilde-expand-string string))
(dir (pathname-directory-pathname string))
(let* ((namestring (tilde-expand-string string))
(name-dir (if (file-exists-p namestring)
(fs:parent-dir-path namestring)
namestring))
(dir (pathname->directory-pathname namestring))
(namefun (if (relative-pathname-p string)
#'namestring
(lambda (x) (namestring (merge-pathnames x))))))
@ -92,7 +96,8 @@ completed) and the common prefix of the completion string."
while entry collect
(funcall namefun entry)))
(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)
(lambda (a b) (< (length a)
(length b))))))