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))
(let ((completions ((find-completer type cmd) cmd to-complete)))
(debug-message "Possible completions " completions)
(cond
((= (length completions) 1)
(case (length completions)
((0) #f)
((1)
(call-with-values
(lambda ()
(unparse-command-line
parsed (lambda (to-complete)
(display (car completions)))))
(lambda (completed-line cursor-index)
(list completed-line cursor-index to-complete parsed))))
(else
(list completions cursor-index to-complete parsed))))))))
(list completed-line '() cursor-index to-complete parsed))))
(else
(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)))
;; F7 toggle scheme-mode / command-mode (FIXME: find a better key)
((= ch key-f7)
((= ch key-home)
(toggle-command/scheme-mode)
(loop (wait-for-input) #f #f))
((= ch key-f8)
((= ch key-end)
(show-shell-screen)
(paint)
(loop (wait-for-input) #f #f))
@ -738,13 +738,14 @@
;; #### beep or so
#f)
(destructure
(((completions cursor-index to-complete cmdln) completion-info))
(((completed-line completions cursor-index to-complete cmdln) completion-info))
(cond
((string? completions)
((null? completions)
;; #### don't ask
(display-completed-line completions (+ 2 cursor-index))
(display-completed-line completed-line (+ 2 cursor-index))
#f)
((list? completions)
(display-completed-line completed-line (+ 2 cursor-index))
(let* ((select-list
(completions->select-list
completions

66
scheme/std-command.scm
View File

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