Mercurial > core / lisp/lib/cli/clap/util.lisp
changeset 645: |
3e6a17fb5712 |
parent: |
f901de70a80e
|
child: |
6e5006dfe7b8 |
author: |
Richard Westhaver <ellis@rwest.io> |
date: |
Wed, 11 Sep 2024 17:24:07 -0400 |
permissions: |
-rw-r--r-- |
description: |
clap upgrades |
1 ;;; cli/clap/util.lisp --- Clap Utilities 6 (in-package :cli/clap/util) 8 (defun arg0 () (car sb-ext:*posix-argv*)) 9 (defun args () (cdr sb-ext:*posix-argv*)) 11 (declaim (inline long-opt-p long-opt-has-eq-p 12 short-opt-p opt-group-p 13 opt-string-prefix-eq)) 15 (defun long-opt-p (str) 16 (declare (simple-string str)) 17 (and (char= (aref str 0) (aref str 1) #\-) 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))))) 27 (defun short-opt-p (str) 28 (declare (simple-string str)) 29 (and (char= (aref str 0) #\-) 30 (not (char= (aref str 1) #\-)) 33 (defun opt-group-p (str) 34 (declare (simple-string str)) 35 (equalp str *cli-group-separator*)) 37 (defun opt-string-prefix-eq (ch str) 38 (declare (simple-string str) (character ch)) 39 (char= ch (aref str 0))) 41 ;; currently not in use 42 (defun gen-thunk-ll (origin args) 43 (let ((a0 (list (symbolicate '$a 0) origin))) 45 (nconc (loop for i from 1 for a in args nconc (list (symbolicate '$a (the fixnum i)) a)) a0) 48 (defun default-thunk (args opts) 49 (declare (ignore args opts)) 52 (defun cli-opt-kind-p (s) 53 (declare (type symbol s)) 54 (find s *cli-opt-kinds* :test 'string-equal))