raco: show all the matching commands for an ambiguous prefix

racket/collects/raco/raco.rkt

@@ -1,27 +1,38 @@
 #lang racket/base
 (require "command-name.rkt"
-         "all-tools.rkt")
+         "all-tools.rkt"
+         racket/string)
 
 (module test racket/base)
 
-(define (find-by-prefix hash str)
-  (let ([trie (make-hash)])
-    (for ([key (in-hash-keys hash)])
-      (for/fold ([trie trie]) ([c (string->list key)])
-        (let ([next (hash-ref trie c (lambda () (make-hash)))])
-          (if (hash-ref next #f #f)
-              (hash-set! next #f null)
-              (hash-set! next #f key))
-          (hash-set! trie c next)
-          next)))
-    (let ([t (for/fold ([trie trie]) ([c (string->list str)])
-               (and trie
-                    (hash-ref trie c #f)))])
-      (and t
-           (let ([s (hash-ref t #f #f)])
-             (if (string? s)
-                 (hash-ref hash s)
-                 'ambiguous))))))
+(define (filter-by-prefix hash str)
+  (for/hash ([key (in-hash-keys hash)]
+             #:when (string-prefix? key str))
+    (values key (hash-ref hash key))))
+
+(define (filter-importance hash)
+  (for/hash ([key (in-hash-keys hash)]
+             #:when (cadddr (hash-ref hash key)))
+    (values key (hash-ref hash key))))
+
+; sort methods for show-tools
+(define (alphabetic<? a b)
+  (string<? (car a) (car b)))
+
+(define (importance<? a b)
+  (> (or (cadddr a) -inf.0)
+     (or (cadddr b) -inf.0)))
+
+(define (show-tools msg tools all-tools <?)
+  (eprintf "\n~a commands:\n" msg)
+  (define l (sort (hash-map tools (lambda (k v) v)) <?))
+  (define largest (apply max 0 (hash-map all-tools
+                                         (lambda (k v) (string-length (car v))))))
+  (for ([i (in-list l)])
+   (eprintf "  ~a~a~a\n"
+            (car i)
+            (make-string (- largest -3 (string-length (car i))) #\space)
+            (caddr i))))
 
 (define (done [result 0])
   ((executable-yield-handler) result) ; to enable GUI commands
@@ -35,6 +46,14 @@
                     (list* (cadr cmdline) "--help" (cddr cmdline))
                     cmdline)]
        [tools (all-tools)]
+       [prefix-tools (if (pair? cmdline)
+                         (filter-by-prefix tools (car cmdline))
+                         #hasheq())]
+       [tool (and (pair? cmdline)
+                  (or (hash-ref tools (car cmdline) #f)
+                      (and (= (hash-count prefix-tools) 1)
+                           (hash-ref tools (car cmdline) #f))))]
+       [ambiguous? (> (hash-count prefix-tools) 1)]
        [show-all?
         (cond
          [(null? cmdline) #f]
@@ -46,45 +65,28 @@
                    (find-system-path 'run-file)
                    (car cmdline))
           #f]
-         [(or (hash-ref tools (car cmdline) #f)
-              (find-by-prefix tools (car cmdline)))
-          => (lambda (tool)
-               (if (eq? 'ambiguous tool)
-                   (begin
-                     (eprintf "~a: Ambiguous command prefix: ~a\n\n"
-                              (find-system-path 'run-file)
-                              (car cmdline))
-                     #f)
-                   (parameterize ([current-command-line-arguments
-                                   (list->vector (cdr cmdline))]
-                                  [current-command-name (car tool)])
-                     (dynamic-require (cadr tool) #f)
-                     (done))))]
+         [tool
+          (parameterize ([current-command-line-arguments (list->vector (cdr cmdline))]
+                         [current-command-name (car tool)])
+             (dynamic-require (cadr tool) #f)
+             (done))]
+         [ambiguous?
+          (eprintf "~a: Ambiguous command prefix: ~a\n\n"
+                   (find-system-path 'run-file)
+                   (car cmdline))
+          #f]
          [(equal? (car cmdline) "help") #t]
          [else
           (eprintf "~a: Unrecognized command: ~a\n\n"
                    (find-system-path 'run-file)
                    (car cmdline))
           #f])])
   (eprintf "Usage: raco <command> <option> ... <arg> ...\n")
-  (for-each
-   (lambda (show-all?)
-     (eprintf "\n~a commands:\n"
-              (if show-all? "All available" "Frequently used"))
-     (let ([l (sort (hash-map tools (lambda (k v) v))
-                    (if show-all?
-                        (lambda (a b) (string<? (car a) (car b)))
-                        (lambda (a b) (> (or (list-ref a 3) -inf.0) (or (list-ref b 3) -inf.0)))))])
-       (let ([largest (apply max 0 (map (lambda (v) (string-length (car v))) l))])
-         (for ([i (in-list l)])
-           (when (or show-all? (cadddr i))
-             (eprintf "  ~a~a~a\n"
-                      (car i)
-                      (make-string (- largest -3 (string-length (car i))) #\space)
-                      (caddr i)))))))
-   (if show-all?
-       (list #f #t)
-       (list #f)))
+  (when ambiguous?
+    (show-tools "Matching" prefix-tools tools importance<?))
+  (show-tools "Frequently used" (filter-importance tools) tools importance<?)
+  (when show-all?
+    (show-tools "All available" tools tools alphabetic<?))
   (printf "\nA command can be specified by an unambiguous prefix.")
   (unless show-all?
     (printf "\nSee `raco help' for a complete list of commands."))