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

Immediately expand common prefix of completions 

Let ls respect its arguments
This commit is contained in:
mainzelm 2005-09-12 15:34:36 +00:00
parent f07e7fc932
commit 186cebc46a
3 changed files with 74 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
scheme/completer.scm
View File

@ -132,15 +132,39 @@
(destructure (((type cmd to-complete) completion-info)) (destructure (((type cmd to-complete) completion-info))
(let ((completions ((find-completer type cmd) cmd to-complete))) (let ((completions ((find-completer type cmd) cmd to-complete)))
(debug-message "Possible completions " completions) (debug-message "Possible completions " completions)
(cond (case (length completions)
((= (length completions) 1) ((0) #f)
((1)
(call-with-values (call-with-values
(lambda () (lambda ()
(unparse-command-line (unparse-command-line
parsed (lambda (to-complete) parsed (lambda (to-complete)
(display (car completions))))) (display (car completions)))))
(lambda (completed-line cursor-index) (lambda (completed-line cursor-index)
(list completed-line cursor-index to-complete parsed)))) (list completed-line '() cursor-index to-complete parsed))))
(else (else
(list completions cursor-index to-complete parsed)))))))) (let ((common-prefix (strings-common-prefix completions)))
(call-with-values
(lambda ()
(unparse-command-line
parsed (lambda (to-complete)
(display common-prefix))))
(lambda (completed-line cursor-index)
(list completed-line completions cursor-index to-complete parsed)))))))))))
(define (strings-common-prefix strs)
(let lp ((strs (cdr strs))
(len (string-length (car strs)))
(common (car strs)))
(if (null? strs)
common
(let ((new (string-prefix-length (car strs)
common)))
(if (< new len)
(lp (cdr strs)
new
(string-take common new))
(lp (cdr strs)
len
common))))))

11
scheme/nuit-engine.scm
View File

@ -362,11 +362,11 @@
(loop (wait-for-input) #f maybe-selector))) (loop (wait-for-input) #f maybe-selector)))
;; F7 toggle scheme-mode / command-mode (FIXME: find a better key) ;; F7 toggle scheme-mode / command-mode (FIXME: find a better key)
((= ch key-f7) ((= ch key-home)
(toggle-command/scheme-mode) (toggle-command/scheme-mode)
(loop (wait-for-input) #f #f)) (loop (wait-for-input) #f #f))
((= ch key-f8) ((= ch key-end)
(show-shell-screen) (show-shell-screen)
(paint) (paint)
(loop (wait-for-input) #f #f)) (loop (wait-for-input) #f #f))
@ -738,13 +738,14 @@
;; #### beep or so ;; #### beep or so
#f) #f)
(destructure (destructure
(((completions cursor-index to-complete cmdln) completion-info)) (((completed-line completions cursor-index to-complete cmdln) completion-info))
(cond (cond
((string? completions) ((null? completions)
;; #### don't ask ;; #### don't ask
(display-completed-line completions (+ 2 cursor-index)) (display-completed-line completed-line (+ 2 cursor-index))
#f) #f)
((list? completions) ((list? completions)
(display-completed-line completed-line (+ 2 cursor-index))
(let* ((select-list (let* ((select-list
(completions->select-list (completions->select-list
completions completions

66
scheme/std-command.scm
View File

@ -121,8 +121,10 @@
;; We don't care for options that format the output. ;; We don't care for options that format the output.
(define defaults-ls-options (define defaults-ls-options
'((long . #t) (dot-files? . #t) '((long . #t)
(sort-by-mtime . #f) (reverse-sort . #f))) (dot-files? . #t)
(sort-by-mtime . #f)
(reverse-sort . #f)))
(define (parse-ls-arguments args) (define (parse-ls-arguments args)
(let* ((on/off-option-processor (let* ((on/off-option-processor
@ -149,37 +151,47 @@
(lambda (option name args operands) (lambda (option name args operands)
(error "Unknown ls option" name)) (error "Unknown ls option" name))
cons '()))) cons '())))
(map (lambda (p) (receive (options rest) (partition pair? given-args)
(or (assoc (car p) given-args) p)) (values
defaults-ls-options)))) (map (lambda (p)
(or (assoc (car p) options) p))
defaults-ls-options)
rest)))))
(register-plugin! (register-plugin!
(make-command-plugin (make-command-plugin
"ls" "ls"
no-completer no-completer
(lambda (command args) (lambda (command args)
(let* ((options (parse-ls-arguments args)) (debug-message "running ls plugin" command args)
(set? (lambda (opt) (cdr (assoc opt options)))) (receive (options paths) (parse-ls-arguments args)
(sort (let* ((set? (lambda (opt) (cdr (assoc opt options))))
(if (set? 'sort-by-mtime) (sort
(lambda (lst) (if (set? 'sort-by-mtime)
(list-sort (lambda (lst)
(lambda (f g) (list-sort
(< (file-info:mtime (fs-object-info f)) (lambda (f g)
(file-info:mtime (fs-object-info g)))) (< (file-info:mtime (fs-object-info f))
lst)) (file-info:mtime (fs-object-info g))))
(lambda (lst) lst))
(list-sort (lambda (lst)
(lambda (f g) (list-sort
(string<? (fs-object-name f) (fs-object-name g))) (lambda (f g)
lst)))) (string<? (fs-object-name f) (fs-object-name g)))
(reverse lst))))
(if (set? 'reverse-sort) (reverse
reverse (if (set? 'reverse-sort)
(lambda (l) l)))) reverse
(reverse (lambda (l) l))))
(sort (reverse
(directory-files (cwd) (set? 'dot-files?)))))))) (sort
(apply
append
(map (lambda (path)
(if (file-directory? path)
(directory-files path (set? 'dot-files?))
(list (file-name->fs-object path))))
paths)))))))))
(register-plugin! (register-plugin!
(make-command-plugin "ps" (make-command-plugin "ps"