/[cl-cli-parser]/cl-cli-parser/cli-parser.lisp
ViewVC logotype

Contents of /cl-cli-parser/cli-parser.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (show annotations)
Sat Mar 19 19:12:45 2005 UTC (9 years, 1 month ago) by dbueno
Branch: MAIN
Branch point for: dbueno
Initial revision
1 ;;;; $Id: cli-parser.lisp,v 1.1 2005/03/19 19:12:45 dbueno Exp $
2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3 ;;;; Denis Bueno
4 ;;;;
5 ;;;; This software is provided without warranty of any kind, and is
6 ;;;; released under the BSD license. I reserve the right to change
7 ;;;; that, but only in the "more permissive license" direction, if
8 ;;;; such is possible.
9 ;;;;
10 ;;;; Copyright (c) 2004, Denis Bueno
11 ;;;; All rights reserved.
12 ;;;;
13 ;;;; Redistribution and use in source and binary forms, with or
14 ;;;; without modification, are permitted provided that the following
15 ;;;; conditions are met:
16 ;;;;
17 ;;;; Redistributions of source code must retain the above copyright
18 ;;;; notice, this list of conditions and the following
19 ;;;; disclaimer.
20 ;;;;
21 ;;;; Redistributions in binary form must reproduce the above
22 ;;;; copyright notice, this list of conditions and the following
23 ;;;; disclaimer in the documentation and/or other materials
24 ;;;; provided with the distribution.
25 ;;;;
26 ;;;; The name of the Denis Bueno may not be used to endorse or
27 ;;;; promote products derived from this software without specific
28 ;;;; prior written permission.
29 ;;;;
30 ;;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
31 ;;;; CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
32 ;;;; INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
33 ;;;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
34 ;;;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS
35 ;;;; BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
36 ;;;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
37 ;;;; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
38 ;;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
39 ;;;; ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
40 ;;;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
41 ;;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
42 ;;;; POSSIBILITY OF SUCH DAMAGE.
43 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
44 ;;;; Command-line argument parser. Mostly parses options of the same
45 ;;;; form that getopt parses.
46 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
47
48 (defpackage cli-parser
49 (:use :common-lisp :common-lisp-user)
50 (:export #:cli-parse
51 #:cli-parse-hash
52 #:cli-parse-assoc
53
54 ;; The cli-option struct
55 #:cli-option
56 #:cli-option-abbr
57 #:cli-option-full
58 #:cli-option-requires-arguments
59 #:cli-option-description
60 #:cli-option-example
61 #:cli-option-p
62 #:make-cli-option)
63 (:documentation
64 "Used for command-line-interface parsing, in the same tradition
65 as getopt, but, a bit more convenient. The three exported main
66 functions are:
67
68 CLI-PARSE
69 CLI-PARSE-HASH
70 CLI-PARSE-ASSOC
71
72 cli-parse actually just calls cli-parse-hash, which will parse a
73 list of command-line arguments against a list of cli-option
74 objects. cli-parse-assoc, instead of returning a hash table of
75 results like cli-parse-hash does, returns an assoc list of
76 results.
77
78 The idea is that you create a bunch of cli-option
79 instances (make-cli-option) which represent all of the valid
80 options the user may pass in to your program. The actual options
81 passed in (as a list of strings, one for each option) along with
82 the list of valid options are passed to cli-parse, which will
83 give you a table of mappings, from the option to the setting
84 specified by the user.
85
86 See the cli-option struct for some details."))
87
88 (in-package :cli-parser)
89
90 (defstruct cli-option
91 (abbr nil :type (or string null))
92 (full "" :type string)
93 (requires-arguments nil :type boolean)
94 (description "" :type string)
95 (example "" :type string))
96
97 (setf (documentation 'cli-option-abbr 'function)
98 "Abbreviation for this command-line option."
99 (documentation 'cli-option-full 'function)
100 "The full name of this command-line option."
101 (documentation 'cli-option-requires-arguments 'function)
102 "Whether this command-line option requires arguments."
103 (documentation 'cli-option-description 'function)
104 "A sentence of description of this command-line option."
105 (documentation 'cli-option-example 'function)
106 "An example of the usage of this command-line option."
107 (documentation 'cli-option-p 'function)
108 "Test whether the argument is a cli-option.")
109
110 (defvar *single-dash* #\-
111 "Short option prefix.")
112 (defvar *double-dash* "--"
113 "Long option prefix.")
114 (defvar *option-value-sep* " "
115 "String used to separate option values.")
116
117
118 ;; Main interface function. Call cli-parse on a list of the form:
119 ;; ("--opt1=val1" "val2" "-p=another-option" "-q"), or a list of the
120 ;; form ("--opt1=val1 val2" "-p=another-option" "-q") - both are
121 ;; equivalent. Returns an association list of the form:
122 ;; (("option-name" ("val1" ... "valn")) ...). The cli-opts argument
123 ;; should be a list of cli-option structures. They specify the
124 ;; allowable command-line interface options.
125
126 (defun cli-parse (args cli-opts)
127 "See cli-parse-hash."
128 (declare (inline cli-parse-hash))
129 (cli-parse-hash args cli-opts))
130
131
132 (defun cli-parse-assoc (args cli-opts)
133 "Parses command-line arguments (as generated by clisp), much
134 in the same format as the cl-args that getopt() parses. That is,
135 if you call any program with: './prgm --opt1=value1 value2 -n',
136 and you give \"--opt1=value1\" and \"-n\" to cli-parse-assoc, it
137 returns and assoc-list of the form ((\"opt1\" (\"value1\"
138 \"value2\")) (\"n\" nil))."
139 (to-full-opt-names (cli-parse-assoc-aux (coalesce-options args) nil) cli-opts))
140 (defun cli-parse-assoc-aux (args results)
141 "Helper for cli-parse."
142 (cond ((endp args) (reverse results))
143 (t (cli-parse-assoc-aux (cdr args)
144 (cons (list (opt-name (car args))
145 (opt-values (car args)))
146 results)))))
147
148 (defun cli-parse-hash (args cli-opts)
149 "Parses command-line arguments in the same form as specified for
150 cli-parse-assoc, but returns a hash-table of the results, instead of an
151 assoc list."
152 (cli-parse-hash-aux (coalesce-options args) cli-opts))
153 (defun cli-parse-hash-aux (args cli-opts)
154 (let ((ret (make-hash-table :test #'equal)))
155 (mapcar #'(lambda (arg val)
156 (setf (gethash (abbr->full-opt-name arg cli-opts) ret) val))
157 (mapcar #'opt-name args)
158 (mapcar #'opt-values args))
159 ret))
160
161
162 (defun coalesce-options (args)
163 "Will convert a list of the form (\"--option-name=val1[,]\"
164 \"val2[,]\" \" ... \"valn\" ...) to a list of the form
165 \(\"--option-name=val1 val2 val3\" ...)."
166 (coalesce-options-aux args nil))
167 (defun coalesce-options-aux (args results)
168 "Helper for coalesce-options."
169 (cond ((or (endp args)
170 (endp (cdr args))) (nreverse (cons (car args) results)))
171 ((and (opt-p (first args))
172 (not (opt-p (second args))))
173 (coalesce-options-aux
174 (cons (concatenate 'string
175 (first args)
176 " "
177 (second args))
178 (cddr args))
179 results))
180 (t (coalesce-options-aux (cdr args) (cons (car args) results)))))
181
182 (defun opt-name (opt)
183 "Extract the name of an option: for example \"opt1\" is the name
184 from \"--opt1=val1\". Will return the argument if it is neither."
185 (cond ((abbr-opt-p opt)
186 (subseq opt 1 (end-opt-name opt)))
187 ((full-opt-p opt)
188 (subseq opt 2 (end-opt-name opt)))
189 (t opt)))
190
191 (defun end-opt-name (opt)
192 "Returns the index of the end of the option-name. For example,
193 end-opt-name would return 6 for the option \"--opt1=val1\""
194 (let ((equal-pos (search "=" opt))
195 (space-pos (search " " opt)))
196 (cond ((and equal-pos space-pos) (min equal-pos space-pos))
197 ((or equal-pos space-pos) (or equal-pos space-pos))
198 (t (length opt)))))
199
200 (defun abbr->full-opt-name (opt cli-opts)
201 "Converts an abbreviated option (i.e. \"o\") to its corresponding full
202 option name. Returns the argument if no conversion is performed."
203 (cond ((endp cli-opts) opt)
204 ((equal opt (cli-option-abbr (car cli-opts)))
205 (cli-option-full (car cli-opts)))
206 ((equal opt (cli-option-full (car cli-opts)))
207 opt)
208 (t (abbr->full-opt-name opt (cdr cli-opts)))))
209
210 (defun to-full-opt-names (cl-args cli-opts)
211 "Converts any abbreviated option list of command-line options to the
212 full option name."
213 (let ((result nil)
214 (cli-short-opts (mapcar #'cli-option-abbr cli-opts)))
215 (dolist (obj cl-args)
216 (if (member (car obj) cli-short-opts :test #'string-equal)
217 (push (cons (abbr->full-opt-name (car obj) cli-opts)
218 (cdr obj))
219 result)
220 (push obj result)))
221 (nreverse result)))
222
223 (defun to-full-opt-name (argname cli-opts)
224 "Convert an option name to the full one, if necessary. Change \"o\"
225 to \"outfile\", for example."
226 (dolist (cli-opt cli-opts)
227 (when (string= argname (cli-option-abbr cli-opt))
228 (return (cli-option-full cli-opt)))))
229
230 (defun opt-values (opt)
231 "Extract the values of an option: for example \"val1\" is the value
232 from \"--opt1=val1\". If no values are specified, this function
233 returns nil."
234 (let ((opt (string-trim '(#\Space) opt))
235 (start (or (search "=" opt) (search " " opt))))
236 (if start
237 ;; separate entries by *option-value-sep*
238 (string-tokenize (subseq opt (1+ start)) (list *option-value-sep* ","))
239 nil)))
240
241
242
243 ;; The distinction between whether an option is abbreviated or full
244 ;; doesn't really matter (as far as getting the names and the
245 ;; corresponding values), but it does matter for checking that options
246 ;; are given in the correct form (i.e. -o=val instead of --o=val for
247 ;; short options, and --thing=val instead of -thing=val for long
248 ;; options).
249 (defun opt-p (opt)
250 "Evaluates to true if opt is an abbreviated or a full option."
251 (or (abbr-opt-p opt)
252 (full-opt-p opt)))
253
254 (defun abbr-opt-p (opt)
255 "Test whether opt is a short option of the form \"-o[=val]\""
256 (and (stringp opt)
257 (>= (length opt) 2)
258 (equal (elt opt 0) *single-dash*)
259 (<= (end-opt-name opt) 2)))
260
261 (defun full-opt-p (opt)
262 "Test whether opt is a long option of the form \"--opt[=val]\""
263 (and (stringp opt)
264 (>= (length opt) 4)
265 (equal (subseq opt 0 (length *double-dash*)) *double-dash*)
266 (> (end-opt-name opt) 3)))
267
268 ;;; STRING-TOKENIZE
269
270 (defun string-tokenize (str val-separators &key (include-separators nil))
271 "Breaks up a given string into string components by splitting
272 the string every time an element of val-separator is
273 encountered. Returns a list of strings, which are all the
274 tokens. If include-separators is non-nil, the separators
275 themselves will be included in the parse."
276 (string-tokenize-aux str val-separators nil include-separators))
277 (defun string-tokenize-aux (str val-separators vals include-separators)
278 "Helper for string-tokenize."
279 ;; the if in the return clause takes care of the extra delimeter
280 ;; variable consed onto the end of the list. This implementation is
281 ;; cleaner than the alternative (which is to keep around a variable
282 ;; which will allow the function to distinguish between the
283 ;; first-time it's called, and the rest of the times it's called.
284 (cond ((null str) (if include-separators
285 (remove-if #'(lambda (item) (equal "" item))
286 (butlast (nreverse vals)))
287 (remove-if #'(lambda (item) (equal "" item))
288 (nreverse vals))))
289 (include-separators
290 (multiple-value-bind (first separator)
291 (st-first-val str val-separators)
292 (string-tokenize-aux (st-rest-of str val-separators)
293 val-separators
294 (cons separator
295 (cons first vals))
296 include-separators)))
297 (t (string-tokenize-aux (st-rest-of str val-separators)
298 val-separators
299 (cons (st-first-val str val-separators) vals)
300 include-separators))))
301 (defun st-first-val (str val-separators)
302 "Returns the first token by parsing str. Analagous to car, but for the
303 string tokenizer, instead of for lists."
304 (let ((best-idx (st-closest-val str val-separators)))
305 (values (subseq str 0 best-idx)
306 (unless (equal (length str) best-idx)
307 (subseq str best-idx (1+ best-idx))))))
308 (defun st-rest-of (str val-separators)
309 "Returns the rest of the string, not including the first
310 token. Analagous to cdr, but for the string tokenizer, instead of for
311 lists."
312 (let* ((str-length (length str))
313 (best-idx (st-closest-val str val-separators)))
314 (if (equal str-length best-idx)
315 nil
316 (subseq str (1+ best-idx)))))
317 (defun st-closest-val (str val-separators)
318 "Returns the character in the string which both matches any of the
319 val-separators and minimizes the distance between it and the index 0
320 of the string. If there is no match, returns the length of the
321 string."
322 (let* ((str-length (length str))
323 (best-idx str-length)
324 (sep-match nil))
325 (mapc #'(lambda (separator)
326 (let ((search-result (search separator str)))
327 (unless (null search-result)
328 (when (< search-result best-idx)
329 (setf best-idx search-result)
330 (setf sep-match separator)))))
331 val-separators)
332 best-idx))
333
334
335 (pushnew :cli-parser *features*)
336
337 ;;;; EOF

  ViewVC Help
Powered by ViewVC 1.1.5