# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1599063159 14400
# Node ID 5e6b2fd0a0e1afcc40e3d69463381d258ba9d2f0
# Parent  411d31e2360b79ec5de25655ce09db1757e55bdf
Add --one to pick

diff -r 411d31e2360b -r 5e6b2fd0a0e1 lisp/pick.lisp
--- a/lisp/pick.lisp	Wed Sep 02 11:45:44 2020 -0400
+++ b/lisp/pick.lisp	Wed Sep 02 12:12:39 2020 -0400
@@ -32,20 +32,33 @@
               ((matchesp line '("y" "yes")) (return t))
               ((matchesp line '("n" "no" "")) (return nil)))))
 
-(defun filter (choices)
+(defun filter-many (choices)
   (loop
     :with width = (1+ (reduce #'max choices :key #'length :initial-value 0))
     :for choice :in choices
     :when (prompt "~A~vA[yN] " choice (- width (length choice)) #\space)
     :collect choice))
 
+(defun filter-one (choices)
+  (loop :for choice :in choices
+        :for i :from 0
+        :do (format *interactive-output* "~36R) ~A~%" i choice)
+        :collect choice)
+  (let ((i (parse-integer (read-line *interactive-input*) :radix 36)))
+    (if (or (minusp i) (>= i (length choices)))
+      (error "Bad choice ~d" i)
+      (list (elt choices i)))))
+
 (defun output (results)
   (loop :for (r . remaining) :on results
         :do (write-string r)
         :when remaining :do (write-string *separator*)))
 
-(defun run (choices)
-  (output (filter choices)))
+(defun run-many (choices)
+  (output (filter-many choices)))
+
+(defun run-one (choices)
+  (output (filter-one choices)))
 
 
 ;;;; User Interface -----------------------------------------------------------
@@ -86,6 +99,22 @@
     :short #\0
     :reduce (constantly (string #\nul))))
 
+(defparameter *option-one*
+  (adopt:make-option 'one
+    :help "Pick a single line instead of picking one-by-one."
+    :long "one"
+    :short #\o
+    :reduce (constantly t)
+    :initial-value nil))
+
+(defparameter *option-many*
+  (adopt:make-option 'many
+    :result-key 'one
+    :help "Pick multiple lines, asking one-by-one (the default)."
+    :long "many"
+    :short #\O
+    :reduce (constantly nil)))
+
 
 (adopt:define-string *help-text*
   "pick displays its arguments one-by-one on standard error and prompts you ~
@@ -97,6 +126,11 @@
    arguments are present prevents something like 'pick `ls -1 | grep foo`' from ~
    silently hanging forever if no files match.~@
    ~@
+   Using the --one argument changes the behaviour of pick.  Instead of ~
+   picking several lines from the input by asking one-by-one, all of the lines ~
+   are presented at once and the user is prompted to pick one of them with ~
+   a prefix.
+   ~@
    This version was inspired by the pick program described in 'The UNIX ~
    Programming Environment'.")
 
@@ -110,7 +144,9 @@
     :contents (list *option-help*
                     *option-version*
                     *option-separator*
-                    *option-null*)))
+                    *option-null*
+                    *option-one*
+                    *option-many*)))
 
 
 (defun toplevel ()
@@ -120,11 +156,15 @@
               ((gethash 'version options) (write-line *version*) (adopt:exit)))
         (with-open-file (*interactive-input* "/dev/tty" :direction :input)
           (let ((*separator* (gethash 'separator options))
-                (*interactive-output* *error-output*))
-            (run (mapcan (lambda (arg)
-                           (if (string= "-" arg)
-                             (read-lines *standard-input*)
-                             (list arg)))
-                         arguments)))))
+                (*interactive-output* *error-output*)
+                (arguments (mapcan (lambda (arg)
+                                     (if (string= "-" arg)
+                                       (read-lines *standard-input*)
+                                       (list arg)))
+                                   arguments)))
+            (funcall (if (gethash 'one options)
+                       #'run-one
+                       #'run-many)
+                     arguments))))
     (error (c) (adopt:print-error-and-exit c))))