From 09446473c823c55e5429a51a584f0459ad474c02 Mon Sep 17 00:00:00 2001 From: eknauel Date: Mon, 30 May 2005 09:33:07 +0000 Subject: [PATCH] Make completions for commands work. Infrastructure for completions of arbitrary args. --- scheme/nuit-engine.scm | 210 ++++++++++++++++++++++++++++++++++++----- 1 file changed, 186 insertions(+), 24 deletions(-) diff --git a/scheme/nuit-engine.scm b/scheme/nuit-engine.scm index 37aad26..867579e 100644 --- a/scheme/nuit-engine.scm +++ b/scheme/nuit-engine.scm @@ -42,6 +42,8 @@ (define result-window #f) (define result-frame-window #f) +(define executable-completions #f) + (define key-control-x 24) (define key-o 111) (define key-tab 9) @@ -275,38 +277,70 @@ (define (run) (init-windows!) + (init-executables-completion-set!) + '(set-interrupt-handler interrupt/keyboard (lambda a (set! active-keyboard-interrupt a))) ;;Loop (paint) - (let loop ((ch (wait-for-input)) (c-x-pressed? #f)) + (let loop ((ch (wait-for-input)) (c-x-pressed? #f) + (completion-select-list #f)) + (cond ;; Ctrl-x -> wait for next input ((= ch key-control-x) - (loop (wait-for-input) #t)) + (loop (wait-for-input) #t completion-select-list)) + ;; 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)))) + + ;; tab pressed twice, select completion using select-list + ((and (focus-on-command-buffer?) + completion-select-list + (= ch key-tab)) + (focus-result-buffer!) + (loop (wait-for-input) #f completion-select-list)) + + ;; tab is pressed in the first place, offer completions ((and (focus-on-command-buffer?) (= ch key-tab)) - (offer-completions (last (buffer-text command-buffer))) - (loop (wait-for-input) #f)) + (let ((maybe-select-list + (offer-completions (last (buffer-text command-buffer))))) + (loop (wait-for-input) #f maybe-select-list))) ;; F7 toggle scheme-mode / command-mode (FIXME: find a better key) ((= ch key-f7) (toggle-command/scheme-mode) - (loop (wait-for-input) #f)) + (loop (wait-for-input) #f #f)) ((= ch key-f8) (show-shell-screen) (paint) - (loop (wait-for-input) #f)) + (loop (wait-for-input) #f #f)) ;; C-x o --- toggle buffer focus ((and c-x-pressed? (= ch key-o)) (toggle-buffer-focus) - (loop (wait-for-input) #f)) + (loop (wait-for-input) #f #f)) ;; C-x p --- insert selection ((and c-x-pressed? @@ -317,7 +351,7 @@ (post-message (history-entry-plugin (entry-data (current-history-item))) (make-selection-message (active-command) (current-result)))) - (loop (wait-for-input) #f)) + (loop (wait-for-input) #f #f)) ((and c-x-pressed? (focus-on-result-buffer?)) (let ((key-message @@ -329,7 +363,7 @@ (post-message (history-entry-plugin (entry-data (current-history-item))) key-message)) - (loop (wait-for-input) #f))) + (loop (wait-for-input) #f #f))) ;; C-x r --- redo ((and c-x-pressed? (focus-on-command-buffer?) @@ -341,7 +375,7 @@ ((= ch key-f2) (paint) - (loop (wait-for-input) c-x-pressed?)) + (loop (wait-for-input) c-x-pressed? #f)) ;; forward in result history ((= ch key-npage) @@ -350,7 +384,7 @@ (paint-active-command-window) (paint-result-window (entry-data (current-history-item)))) (refresh-result-window) - (loop (wait-for-input) c-x-pressed?)) + (loop (wait-for-input) c-x-pressed? #f)) ;; back in result history ((= ch key-ppage) @@ -359,11 +393,11 @@ (paint-active-command-window) (paint-result-window (entry-data (current-history-item)))) (refresh-result-window) - (loop (wait-for-input) c-x-pressed?)) + (loop (wait-for-input) c-x-pressed? #f)) ((and (focus-on-command-buffer?) (= ch 10)) (handle-return-key) - (loop (wait-for-input) c-x-pressed?)) + (loop (wait-for-input) c-x-pressed? #f)) (else (cond @@ -379,7 +413,7 @@ (paint-result-window (entry-data (current-history-item))) (move-cursor command-buffer result-buffer) (refresh-result-window)) - (loop (wait-for-input) #f)) + (loop (wait-for-input) #f #f)) (else (input command-buffer ch) (werase (app-window-curses-win command-window)) @@ -387,7 +421,7 @@ command-buffer) (move-cursor command-buffer result-buffer) (refresh-command-window) - (loop (wait-for-input) c-x-pressed?))))))) + (loop (wait-for-input) c-x-pressed? #f))))))) (define (window-init-curses-win! window) (set-app-window-curses-win! @@ -446,6 +480,19 @@ (map app-window-curses-win all-windows)) (clear))) +(define (get-path-list) + (cond + ((getenv "PATH") + => (lambda (str) + (string-tokenize + str (char-set-difference char-set:full (char-set #\:))))) + (else + '("/usr/bin" "/bin" "/usr/sbin" "/sbin")))) + +(define (init-executables-completion-set!) + (set! executable-completions + (make-completion-set-for-executables (get-path-list)))) + (define (paint-bar-1) (mvwaddstr (app-window-curses-win bar-1) 0 1 "SCSH-NUIT") (wrefresh (app-window-curses-win bar-1))) @@ -741,21 +788,136 @@ (loop (cdr lst) (string-append str " " (car lst)))))) -(define (completions->select-list completions) +(define (completions->select-list completions num-lines) (debug-message "possible completions " completions) (make-select-list (map (lambda (s) (make-unmarked-element s #f s)) completions) - (result-buffer-num-lines result-buffer))) + num-lines)) + +(define (command-contains-path? command) + (or (string-contains command "/") + (string-contains command "~") + (string-contains command ".."))) + +(define (executables-in-dir dir) + (with-cwd dir + (filter-map + (lambda (file) + (and (or (file-executable? file) (file-directory? file)) + (absolute-file-name file dir))) + (directory-files)))) + +(define (complete-path path) + (let ((dir (file-name-directory path))) + (map (lambda (p) + (if (string-prefix? "/" p) + p + (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 (command-mode-complete command) + (cond + ((command-contains-path? command) + (let ((new + (complete-executable/path (expand-file-name command (cwd))))) + (debug-message "command-mode-complete " command) + new)) + (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))) + +(define (paint-completion-select-list select-list command) + (let ((win (app-window-curses-win result-window))) + (wclear win) + (wattron win (A-BOLD)) + (mvwaddstr win 0 0 + (string-append "Possible completions for " command)) + (wattrset win (A-NORMAL)) + (paint-result-buffer (paint-selection-list-at select-list 0 2)) + (refresh-result-window))) (define (offer-completions command) - (debug-message "offer-completions " command) - (let ((select-list - (completions->select-list - (completions-for (command-completions) command)))) - (wclear (app-window-curses-win result-window)) - (paint-result-buffer (paint-selection-list select-list)) - (refresh-result-window))) + (let* ((tokens/cursor-list (tokenize-command command)) + (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))) + (if (= (length completions) 1) + (begin + (complete-in-command-buffer command (car completions)) + #f) + (let ((select-list + (completions->select-list + completions (- (result-buffer-num-lines result-buffer) 3)))) + (paint-completion-select-list select-list command) + select-list))))))) + +(define (find-token-with-cursor tokens/cursor-list) + (let lp ((lst tokens/cursor-list) (i 0)) + (cond + ((null? lst) + (values #f i)) + ((cdar lst) + (values (caar lst) i)) + (else + (lp (cdr lst) (+ i 1)))))) + +(define (command-token-delimiter? c) + (char-set-contains? char-set:whitespace c)) + +(define (skip-delimters delimiter? chars) + (let lp ((chars chars) (i 0)) + (cond + ((null? chars) (values '() i)) + ((delimiter? (car chars)) + (lp (cdr chars) (+ i 1))) + (else (values chars i))))) + +(define (tokenize-command command) + (let ((cursor-pos (- (buffer-pos-col command-buffer) 2))) ;; don't ask + (let lp ((chars (string->list command)) + (token "") + (tokens '()) + (i 0)) + (cond + ((null? chars) + (reverse (cons (cons token (= i cursor-pos)) tokens))) + ((command-token-delimiter? (car chars)) + (call-with-values + (lambda () + (skip-delimters command-token-delimiter? chars)) + (lambda (rest skipped) + (lp rest "" (cons (cons token (= i cursor-pos)) tokens) + (+ i skipped))))) + (else + (lp (cdr chars) (string-append token (string (car chars))) + tokens (+ i 1))))))) (define-record-type standard-result-obj standard-result-obj (make-standard-result-obj cursor-pos-y