Make completion work on (almost) all positions of the cursor in the
command line.
This commit is contained in:
eknauel
parent
09446473c8
commit
1e356587a4
|
|
@ -286,46 +286,31 @@
|
|||
;;Loop
|
||||
(paint)
|
||||
(let loop ((ch (wait-for-input)) (c-x-pressed? #f)
|
||||
(completion-select-list #f))
|
||||
(completion-selector #f))
|
||||
|
||||
(cond
|
||||
|
||||
;; Ctrl-x -> wait for next input
|
||||
((= ch key-control-x)
|
||||
(loop (wait-for-input) #t completion-select-list))
|
||||
(loop (wait-for-input) #t completion-selector))
|
||||
|
||||
;; user hit tab twice and pressed some other key to navigate the
|
||||
;; completion-select-list
|
||||
((and (focus-on-result-buffer?) completion-select-list)
|
||||
(if (= ch 10)
|
||||
(begin
|
||||
(focus-command-buffer!)
|
||||
(complete-in-command-buffer
|
||||
(last (buffer-text command-buffer))
|
||||
(select-list-selected-entry completion-select-list))
|
||||
(loop (wait-for-input) c-x-pressed? #f))
|
||||
(let ((select-list
|
||||
(select-list-handle-key-press
|
||||
completion-select-list
|
||||
(make-key-pressed-message (active-command) (current-result)
|
||||
result-buffer ch #f))))
|
||||
(paint-completion-select-list
|
||||
select-list (last (buffer-text command-buffer)))
|
||||
(loop (wait-for-input) c-x-pressed? select-list))))
|
||||
((and (focus-on-result-buffer?) completion-selector)
|
||||
(let ((new-selector (completion-selector ch)))
|
||||
(loop (wait-for-input) c-x-pressed? new-selector)))
|
||||
|
||||
;; tab pressed twice, select completion using select-list
|
||||
((and (focus-on-command-buffer?)
|
||||
completion-select-list
|
||||
completion-selector
|
||||
(= ch key-tab))
|
||||
(focus-result-buffer!)
|
||||
(loop (wait-for-input) #f completion-select-list))
|
||||
(loop (wait-for-input) #f completion-selector))
|
||||
|
||||
;; tab is pressed in the first place, offer completions
|
||||
((and (focus-on-command-buffer?)
|
||||
(= ch key-tab))
|
||||
(let ((maybe-select-list
|
||||
(let ((maybe-selector
|
||||
(offer-completions (last (buffer-text command-buffer)))))
|
||||
(loop (wait-for-input) #f maybe-select-list)))
|
||||
(loop (wait-for-input) #f maybe-selector)))
|
||||
|
||||
;; F7 toggle scheme-mode / command-mode (FIXME: find a better key)
|
||||
((= ch key-f7)
|
||||
|
|
@ -800,11 +785,11 @@
|
|||
(string-contains command "~")
|
||||
(string-contains command "..")))
|
||||
|
||||
(define (executables-in-dir dir)
|
||||
(define (files-in-dir file-filter dir)
|
||||
(with-cwd dir
|
||||
(filter-map
|
||||
(lambda (file)
|
||||
(and (or (file-executable? file) (file-directory? file))
|
||||
(and (file-filter file)
|
||||
(absolute-file-name file dir)))
|
||||
(directory-files))))
|
||||
|
||||
|
|
@ -816,38 +801,72 @@
|
|||
(string-append dir p)))
|
||||
(glob (string-append path "*")))))
|
||||
|
||||
(define (complete-executable/path command)
|
||||
(if (and (file-exists? command) (file-directory? command))
|
||||
(executables-in-dir command)
|
||||
(complete-path command)))
|
||||
(define (complete-with-filesystem-objects filter partial-name)
|
||||
(if (and (file-exists? partial-name) (file-directory? partial-name))
|
||||
(files-in-dir filter partial-name)
|
||||
(complete-path partial-name)))
|
||||
|
||||
(define (command-mode-complete command)
|
||||
(define (complete-executables/path partial-name)
|
||||
(complete-with-filesystem-objects
|
||||
(lambda (file)
|
||||
(or (file-executable? file) (file-directory? file)))
|
||||
partial-name))
|
||||
|
||||
(define (complete-files/path partial-name)
|
||||
(complete-with-filesystem-objects
|
||||
(lambda (file) #t) partial-name))
|
||||
|
||||
(define (command-mode-completer command prefix args args-pos)
|
||||
(debug-message "command-mode-completer" prefix "|" args "|" args-pos)
|
||||
(cond
|
||||
((command-contains-path? command)
|
||||
(let ((new
|
||||
(complete-executable/path (expand-file-name command (cwd)))))
|
||||
(debug-message "command-mode-complete " command)
|
||||
new))
|
||||
((command-contains-path? prefix)
|
||||
;; #### FIXME ignore errors here?
|
||||
((if (zero? args-pos)
|
||||
complete-executables/path
|
||||
complete-files/path)
|
||||
(expand-file-name prefix (cwd))))
|
||||
(else
|
||||
(append
|
||||
(completions-for (command-completions) command)
|
||||
(completions-for-executables executable-completions command)))))
|
||||
|
||||
(define (complete-in-command-buffer command completion)
|
||||
(let ((rest (substring completion
|
||||
(string-length command)
|
||||
(string-length completion))))
|
||||
(debug-message "complete-in-command-buffer "
|
||||
"'" command "'; '" completion "'; "
|
||||
"'" rest "'")
|
||||
(for-each (lambda (c)
|
||||
(input command-buffer (char->ascii c)))
|
||||
(string->list rest))
|
||||
(wclrtoeol (app-window-curses-win command-window))
|
||||
(print-command-buffer (app-window-curses-win command-window)
|
||||
command-buffer)
|
||||
(move-cursor command-buffer result-buffer)
|
||||
(refresh-command-window)))
|
||||
(completions-for (command-completions) prefix)
|
||||
(completions-for-executables executable-completions prefix)))))
|
||||
|
||||
(define (assemble-line-with-completion command arg arg-pos completion)
|
||||
(debug-message "assemble-line-with-completion "
|
||||
command "," arg "," arg-pos "," completion)
|
||||
(let ((string-append* (lambda (s t)
|
||||
(if (string=? s "")
|
||||
t
|
||||
(string-append s " " t)))))
|
||||
(let lp ((tokens (cons command arg))
|
||||
(arg-count 0)
|
||||
(cursor-pos 0)
|
||||
(line ""))
|
||||
(cond
|
||||
((null? tokens)
|
||||
(values line (+ 2 cursor-pos)))
|
||||
((= arg-count arg-pos)
|
||||
(lp (cdr tokens)
|
||||
(+ arg-count 1)
|
||||
(+ cursor-pos (string-length completion))
|
||||
(string-append* line completion)))
|
||||
(else
|
||||
(lp (cdr tokens)
|
||||
(+ arg-count 1)
|
||||
(+ 1 (+ cursor-pos (string-length (car tokens))))
|
||||
(string-append* line (car tokens))))))))
|
||||
|
||||
(define (display-completed-line line cursor-pos)
|
||||
(debug-message "display-completed-line " line "," cursor-pos)
|
||||
(set-buffer-pos-col! command-buffer cursor-pos)
|
||||
(set-buffer-text! command-buffer
|
||||
(append
|
||||
(drop-right (buffer-text command-buffer) 1)
|
||||
(list line)))
|
||||
(wclrtoeol (app-window-curses-win command-window))
|
||||
(print-command-buffer (app-window-curses-win command-window)
|
||||
command-buffer)
|
||||
(move-cursor command-buffer result-buffer)
|
||||
(refresh-command-window))
|
||||
|
||||
(define (paint-completion-select-list select-list command)
|
||||
(let ((win (app-window-curses-win result-window)))
|
||||
|
|
@ -859,26 +878,84 @@
|
|||
(paint-result-buffer (paint-selection-list-at select-list 0 2))
|
||||
(refresh-result-window)))
|
||||
|
||||
;; #### implement me
|
||||
(define (completer-function-for-command command)
|
||||
#f)
|
||||
|
||||
(define (call-completer command args prefix arg-pos)
|
||||
(cond
|
||||
((= 0 arg-pos)
|
||||
(command-mode-completer command prefix args arg-pos))
|
||||
((completer-function-for-command command)
|
||||
=> (lambda (completer)
|
||||
(completer command prefix args arg-pos)))
|
||||
(else
|
||||
(command-mode-completer command prefix args arg-pos))))
|
||||
|
||||
(define (offer-completions command)
|
||||
(let* ((tokens/cursor-list (tokenize-command command))
|
||||
(args (map car (cdr tokens/cursor-list)))
|
||||
(command (caar tokens/cursor-list)))
|
||||
(call-with-values
|
||||
(lambda ()
|
||||
(find-token-with-cursor tokens/cursor-list))
|
||||
(lambda (prefix arg-pos)
|
||||
;; hook in completer functions here
|
||||
(let ((completions (command-mode-complete command)))
|
||||
;; #### FIXME
|
||||
(if (not prefix)
|
||||
(error "could not determine token with cursor position"
|
||||
tokens/cursor-list command
|
||||
(- (buffer-pos-col command-buffer) 2)))
|
||||
(let ((completions
|
||||
(call-completer command args
|
||||
prefix arg-pos)))
|
||||
(if (= (length completions) 1)
|
||||
(begin
|
||||
(complete-in-command-buffer command (car completions))
|
||||
(call-with-values
|
||||
(lambda ()
|
||||
(assemble-line-with-completion
|
||||
command args arg-pos (car completions)))
|
||||
display-completed-line)
|
||||
#f)
|
||||
(let ((select-list
|
||||
(completions->select-list
|
||||
completions (- (result-buffer-num-lines result-buffer) 3))))
|
||||
(let* ((select-list
|
||||
(completions->select-list
|
||||
completions
|
||||
(- (result-buffer-num-lines result-buffer) 3)))
|
||||
(selector
|
||||
(make-completion-selector
|
||||
select-list completions
|
||||
command args arg-pos)))
|
||||
(paint-completion-select-list select-list command)
|
||||
select-list)))))))
|
||||
(move-cursor command-buffer result-buffer)
|
||||
(refresh-command-window)
|
||||
selector)))))))
|
||||
|
||||
(define (make-completion-selector select-list completions
|
||||
command arg arg-pos)
|
||||
(lambda (key)
|
||||
(cond
|
||||
((= key 10)
|
||||
(focus-command-buffer!)
|
||||
(call-with-values
|
||||
(lambda ()
|
||||
(assemble-line-with-completion
|
||||
command arg arg-pos
|
||||
(select-list-selected-entry select-list)))
|
||||
display-completed-line)
|
||||
#f)
|
||||
(else
|
||||
(let ((new-select-list
|
||||
(select-list-handle-key-press
|
||||
select-list
|
||||
(make-key-pressed-message
|
||||
(active-command) (current-result)
|
||||
result-buffer key #f))))
|
||||
(paint-completion-select-list
|
||||
new-select-list (last (buffer-text command-buffer)))
|
||||
(make-completion-selector
|
||||
new-select-list completions command arg arg-pos))))))
|
||||
|
||||
(define (find-token-with-cursor tokens/cursor-list)
|
||||
(debug-message "find-token-with-cursor " tokens/cursor-list)
|
||||
(let lp ((lst tokens/cursor-list) (i 0))
|
||||
(cond
|
||||
((null? lst)
|
||||
|
|
|
|||
Loading…
Reference in New Issue