Immediately expand common prefix of completions

Let ls respect its arguments

scheme/completer.scm

@@ -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
+	     (case (length completions)
-	      ((= (length completions) 1)
+               ((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))))
+		   (list completed-line '() cursor-index to-complete parsed))))
               (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))))))

scheme/nuit-engine.scm

@@ -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 

scheme/std-command.scm

@@ -121,8 +121,10 @@
 ;; We don't care for options that format the output.
 
 (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)
   (let* ((on/off-option-processor
@@ -149,17 +151,21 @@
 	    (lambda (option name args operands)
 	      (error "Unknown ls option" name))
 	    cons '())))
+      (receive (options rest) (partition pair? given-args)
+        (values
          (map (lambda (p)
-	     (or (assoc (car p) given-args) p))
+                (or (assoc (car p) options) p))
-	   defaults-ls-options))))
+              defaults-ls-options)
+         rest)))))
 	 
 (register-plugin!
  (make-command-plugin 
   "ls"
   no-completer
   (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)
+      (let* ((set? (lambda (opt) (cdr (assoc opt options))))
              (sort
               (if (set? 'sort-by-mtime)
                   (lambda (lst)
@@ -179,7 +185,13 @@
                   (lambda (l) l))))
         (reverse 
          (sort
-	(directory-files (cwd) (set? 'dot-files?))))))))
+          (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"