# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1577416444 0
# Node ID 10792a9107fde60792224246f52447fe11ab795a
# Parent  e39d33e4222c9d6c70ad53e5c74253c0879c8a36
Add initial version of pick

diff -r e39d33e4222c -r 10792a9107fd lisp/pick.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/pick.lisp	Fri Dec 27 03:14:04 2019 +0000
@@ -0,0 +1,118 @@
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload '(:adopt) :silent t))
+
+(defpackage :pick
+  (:use :cl)
+  (:export :toplevel :*ui*))
+
+(in-package :pick)
+
+;;;; Configuration ------------------------------------------------------------
+(defparameter *version* "0.0.1")
+(defparameter *separator* (string #\Newline))
+(defparameter *interactive-input* *query-io*)
+(defparameter *interactive-output* *query-io*)
+
+
+;;;; Functionality ------------------------------------------------------------
+(defun read-lines (stream)
+  (loop :for line = (read-line stream nil)
+        :while line
+        :collect line))
+
+(defun matchesp (string choices)
+  (member string choices :test #'string-equal))
+
+(defun prompt (format-string &rest args)
+  (loop :for line = (progn
+                      (apply #'format *interactive-output* format-string args)
+                      (force-output *interactive-output*)
+                      (read-line *interactive-input*))
+        :do (cond
+              ((matchesp line '("y" "yes")) (return t))
+              ((matchesp line '("n" "no" "")) (return nil)))))
+
+(defun filter (choices)
+  (loop
+    :with width = (1+ (reduce #'max choices :key #'length))
+    :for choice :in choices
+    :when (prompt "~A~vA[yN] " choice (- width (length choice)) #\space)
+    :collect choice))
+
+(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)))
+
+
+;;;; User Interface -----------------------------------------------------------
+(defparameter *examples*
+  '(("Pick some Python files and count their lines:"
+     . "wc -l `pick *.py`")
+    ("Search for some processes and interactively pick some to kill:"
+     . "ps aww | awk 'NR > 1 { print $1, $5 }' | grep htop | pick | cut -d' ' -f1 | xargs kill")))
+
+
+(defparameter *option-help*
+  (adopt:make-option 'help
+    :help "Display help and exit."
+    :long "help"
+    :short #\h
+    :reduce (constantly t)))
+
+(defparameter *option-version*
+  (adopt:make-option 'version
+    :help "Display version information and exit."
+    :long "version"
+    :reduce (constantly t)))
+
+(defparameter *option-separator*
+  (adopt:make-option 'separator
+    :help "Print SEP between records when outputting (default: newline)."
+    :long "separator"
+    :short #\s
+    :initial-value *separator*
+    :parameter "SEP"
+    :reduce #'adopt:last))
+
+(defparameter *option-null*
+  (adopt:make-option 'null
+    :result-key 'separator
+    :help "Use null bytes as separators for output."
+    :long "null"
+    :short #\0
+    :reduce (constantly (string #\nul))))
+
+
+(adopt:define-string *help-text*
+  "pick displays its arguments one-by-one on standard error and prompts you ~
+   interactively to choose some of them.  The chosen items will be printed to ~
+   standard output.")
+
+(defparameter *ui*
+  (adopt:make-interface
+    :name "pick"
+    :usage "[OPTIONS]"
+    :summary "interactively pick some things"
+    :help *help-text*
+    :examples *examples*
+    :contents (list *option-help*
+                    *option-version*
+                    *option-separator*
+                    *option-null*)))
+
+
+(defun toplevel ()
+  (handler-case
+      (multiple-value-bind (arguments options) (adopt:parse-options *ui*)
+        (cond ((gethash 'help options) (adopt:print-help-and-exit *ui* :option-width 24))
+              ((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 (or arguments (read-lines *standard-input*))))))
+    (error (c) (adopt:print-error-and-exit c))))
+