lisp/pick.lisp @ 20e6b1f3b43e

(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 :initial-value 0))
    :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.~@
   ~@
   An argument of - will cause pick to read lines from standard input as ~
   choices.  Using an explicit - instead of reading from standard input when no ~
   arguments are present prevents something like 'pick `ls -1 | grep foo`' from ~
   silently hanging forever if no files match.~@
   ~@
   This version was inspired by the pick program described in 'The UNIX ~
   Programming Environment'.")

(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 (mapcan (lambda (arg)
                           (if (string= "-" arg)
                             (read-lines *standard-input*)
                             (list arg)))
                         arguments)))))
    (error (c) (adopt:print-error-and-exit c))))