changelog shortlog graph tags branches changeset files revisions annotate raw help

Mercurial > core / lisp/lib/cli/clap/util.lisp

changeset 698: 96958d3eb5b0
parent: 119532882cb1
author: Richard Westhaver <ellis@rwest.io>
date: Fri, 04 Oct 2024 22:04:59 -0400
permissions: -rw-r--r--
description: fixes 
     1 ;;; cli/clap/util.lisp --- Clap Utilities
     2 
     3 ;; 
     4 
     5 ;;; Code:
     6 (in-package :cli/clap/util)
     7 
     8 (defun arg0 () (car sb-ext:*posix-argv*))
     9 (defun args () (cdr sb-ext:*posix-argv*))
    10 
    11 (declaim (inline long-opt-p long-opt-has-eq-p
    12                  short-opt-p opt-group-p
    13                  opt-string-prefix-eq))
    14 
    15 (defun long-opt-p (str)
    16   (declare (simple-string str))
    17   (and (> (length str) 2)
    18        (char= (aref str 0) (aref str 1) #\-)))
    19 
    20 (defun long-opt-has-eq-p (str)
    21   "Return non-nil if STR is a long-opt which has an '=' somewhere,
    22 indicating a key/val pair without whitespace."
    23   (declare (simple-string str))
    24   (when-let ((pos (position #\= str :test 'char=)))
    25     (cons (subseq str 2 pos) (subseq str (1+ pos)))))
    26 
    27 (defun short-opt-p (str)
    28   (declare (simple-string str))
    29   (and (char= (aref str 0) #\-)
    30        (> (length str) 1)
    31        (not (char= (aref str 1) #\-))))
    32 
    33 (defun opt-group-p (str)
    34   (declare (simple-string str))
    35   (equalp str *cli-group-separator*))
    36 
    37 (defun opt-keyword-p (str)
    38   (declare (simple-string str))
    39   (char= (aref str 0) #\:))
    40 
    41 (defun opt-string-prefix-eq (ch str)
    42   (declare (simple-string str) (character ch))
    43   (char= ch (aref str 0)))
    44 
    45 ;; currently not in use
    46 (defun gen-thunk-ll (origin args)
    47   (let ((a0 (list (symbolicate '$a 0) origin)))
    48     (group 
    49      (nconc (loop for i from 1 for a in args nconc (list (symbolicate '$a (the fixnum i)) a)) a0)
    50      2)))
    51 
    52 (defun default-thunk (args opts)
    53   (declare (ignore args opts))
    54   (values))
    55 
    56 (defun cli-opt-kind-p (s)
    57   (declare (type symbol s))
    58   (find s *cli-opt-kinds* :test 'string-equal))