Coverage report: /home/ellis/comp/core/lib/cli/clap/util.lisp

KindCoveredAll%
expression23108 21.3
branch010 0.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
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 group-opt-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 short-opt-has-eq-p (str)
21
   "Return non-nil if STR is a short-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 1 pos) (subseq str (1+ pos)))))
26
 
27
 (defun long-opt-has-eq-p (str)
28
   "Return non-nil if STR is a long-opt which has an '=' somewhere,
29
 indicating a key/val pair without whitespace."
30
   (declare (simple-string str))
31
   (when-let ((pos (position #\= str :test 'char=)))
32
     (cons (subseq str 2 pos) (subseq str (1+ pos)))))
33
 
34
 (defun short-opt-p (str)
35
   (declare (simple-string str))
36
   (and (char= (aref str 0) #\-)
37
        (= (length str) 2)
38
        (not (char= (aref str 1) #\-))))
39
 
40
 (defun group-opt-p (str)
41
   (declare (simple-string str))
42
   (equalp str *cli-group-separator*))
43
 
44
 (defun multi-short-opt-p (str)
45
   "Return non-nil if STR is a multi-short-opt - prefixed with a single '-' but
46
 containing multiple characters."
47
   (declare (simple-string str))
48
   (and (char= (aref str 0) #\-)
49
        (not (char= (aref str 1) #\-))))
50
 
51
 (defun opt-keyword-p (str)
52
   (declare (simple-string str))
53
   (char= (aref str 0) #\:))
54
 
55
 (defun opt-string-prefix-eq (ch str)
56
   (char= ch (aref str 0)))
57
 
58
 ;; currently not in use
59
 #+nil
60
 (defun gen-thunk-ll (origin args)
61
   (let ((a0 (list (symbolicate '$a 0) origin)))
62
     (group 
63
      (nconc (loop for i from 1 for a in args nconc (list (symbolicate '$a (the fixnum i)) a)) a0)
64
      2)))
65
 
66
 (defun default-cmd-thunk (args opts)
67
   (declare (ignore args opts))
68
   (values))
69
 
70
 (defun default-opt-thunk (arg)
71
   (identity arg))
72
 
73
 (defun cli-opt-kind-p (s)
74
   (declare (type symbol s))
75
   (find s *cli-opt-kinds* :test 'string-equal))