changelog shortlog graph tags branches changeset files revisions annotate raw help

Mercurial > core / lisp/lib/cli/prompt.lisp

changeset 698: 96958d3eb5b0
parent: 1816f9c53453
author: Richard Westhaver <ellis@rwest.io>
date: Fri, 04 Oct 2024 22:04:59 -0400
permissions: -rw-r--r--
description: fixes 
     1 ;;; lib/cli/prompt.lisp --- Basic CLI Prompts
     2 
     3 ;; TODO
     4 
     5 ;;; Code:
     6 (in-package :cli/prompt)
     7 (declaim (optimize (speed 3) (debug 1)))
     8 
     9 (defvar *completion-trigger* "?")
    10 
    11 (defun completing-read (prompt collection
    12 			&key (history nil) (default nil)
    13                              (require-match t)
    14 			     (test #'string-equal) 
    15                              (input *query-io*)
    16                              (output *query-io*))
    17   "A simplified COMPLETING-READ for common-lisp.
    18 
    19 The Emacs completion framework includes a function called
    20 `completing-read' which prompts the user for input from the
    21 mini-buffer. It is a very flexible interface which can be used to read
    22 user input programatically. This is incredibly useful for building
    23 data entry interfaces -- for example see the `defprompt' macro.
    24 
    25 Obviously writing a completion framework is out-of-scope, but we can
    26 simulate one by embedding a DSL in our prompters if we choose. For
    27 example, perhaps we treat a single '?' character as a request from the
    28 user to list valid options while continue waiting for input."
    29   (declare (list collection)
    30            (function test)
    31            (boolean require-match)
    32            (stream input output))
    33   (labels ((print-coll ()
    34              (println collection output))
    35            (ask ()
    36              (princ prompt output)
    37              (finish-output output)
    38              (listen input)
    39              (let ((line (the string (read-line input))))
    40                (if (equalp *completion-trigger* line)
    41                    (progn
    42                      (print-coll)
    43                      (ask))
    44                    (if (> (length line) 0)
    45                        line
    46                        default)))))
    47     (let ((res (ask)))
    48       (when history (push res history))
    49       (if (and collection require-match)
    50           (find res collection :test test)
    51           res))))
    52 
    53 (defmacro defprompt (var &key (prompt ">") collection default input output)
    54   "Generate a 'prompter' from list or variable VAR and optional
    55 PROMPT string.
    56 
    57 This isn't an ideal solution as it does in fact expose a dynamic
    58 variable (VAR-prompt-history). We should generate accessors and
    59 keep the variables within lexical scope of the generated
    60 closure."
    61   (with-gensyms (h)
    62     `(let ((,h ',(symbolicate '* var '-prompt-history*))) ;; history symbol
    63        (defvar ,(symbolicate '* var '-prompt-history*) nil)
    64        (defun ,(symbolicate var '-prompt) ()
    65 	 ,(format nil "Prompt for a value from `~A', use DEFAULT if non-nil
    66 and no value is provided by user, otherwise fallback to the `car'
    67 of `~A-PROMPT-HISTORY'." var var)
    68 	 (completing-read
    69           (format nil "~A [~A]: "
    70                   ,prompt
    71 		  (or ,default (car (symbol-value ,h))))
    72 	  ,collection
    73           :history ,h
    74           :default ,default
    75           ,@(when input (list :input input))
    76           ,@(when output (list :output output)))))))