scsh-conservatory
/
commander-s
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Make completion work on (almost) all positions of the cursor in the 

command line.
This commit is contained in:
eknauel 2005-05-30 14:08:41 +00:00
parent 09446473c8
commit 1e356587a4
1 changed files with 138 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

187
scheme/nuit-engine.scm
View File

@ -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)))))
(completions-for (command-completions) prefix)
(completions-for-executables executable-completions prefix)))))
(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))
(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)))
(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
(let* ((select-list
(completions->select-list
completions (- (result-buffer-num-lines result-buffer) 3))))
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)