/[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.2 - (show annotations)
Sat Mar 19 20:07:00 2005 UTC (9 years, 1 month ago) by dbueno
Branch: MAIN
Changes since 1.1: +19 -11 lines
changelog and unit tests.
1 ;;;; $Id: cli-parser.lisp,v 1.2 2005/03/19 20:07:00 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 instances (via
79 MAKE-CLI-OPTION) which represent all of the valid options the
80 user may pass in to your program. The actual options passed
81 in (as a list of strings, one for each option) along with the
82 list of valid options are passed to cli-parse, which will give
83 you a table of mappings, from the option to the setting specified
84 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 ;; (defclass cli-option ()
111 ;; ((abbreviation :initarg :abbr :accessor cli-option-abbr)
112 ;; (longname :initarg :long :accessor cli-option-long)
113 ;; (argumentsp :initform nil
114 ;; :initarg :argumentsp :accessor cli-option-argumentsp)
115 ;; (description :initform "Default description."
116 ;; :initarg :description :accesssor cli-option-description)
117 ;; (example :initarg :example :accessor cli-option-example)))
118
119 (defvar *single-dash* #\-
120 "Short option prefix.")
121 (defvar *double-dash* "--"
122 "Long option prefix.")
123 (defvar *option-value-sep* " "
124 "String used to separate option values.")
125
126
127 ;; Main interface function. Call cli-parse on a list of the form:
128 ;; ("--opt1=val1" "val2" "-p=another-option" "-q"), or a list of the
129 ;; form ("--opt1=val1 val2" "-p=another-option" "-q") - both are
130 ;; equivalent. Returns an association list of the form:
131 ;; (("option-name" ("val1" ... "valn")) ...). The cli-opts argument
132 ;; should be a list of cli-option structures. They specify the
133 ;; allowable command-line interface options.
134
135 (defun cli-parse (args cli-opts)
136 "See cli-parse-hash."
137 (cli-parse-hash args cli-opts))
138
139
140 (defun cli-parse-assoc (args cli-opts)
141 "Parses command-line arguments (as generated by clisp), much
142 in the same format as the cl-args that getopt() parses. That is,
143 if you call any program with: './prgm --opt1=value1 value2 -n',
144 and you give \"--opt1=value1\" and \"-n\" to cli-parse-assoc, it
145 returns and assoc-list of the form ((\"opt1\" (\"value1\"
146 \"value2\")) (\"n\" nil))."
147 (to-full-opt-names (cli-parse-assoc-aux (coalesce-options args) nil) cli-opts))
148 (defun cli-parse-assoc-aux (args results)
149 "Helper for cli-parse."
150 (cond ((endp args) (reverse results))
151 (t (cli-parse-assoc-aux (cdr args)
152 (cons (list (opt-name (car args))
153 (opt-values (car args)))
154 results)))))
155
156 (defun cli-parse-hash (args cli-opts)
157 "Parses command-line arguments in the same form as specified for
158 cli-parse-assoc, but returns a hash-table of the results, instead of an
159 assoc list."
160 (cli-parse-hash-aux (coalesce-options args) cli-opts))
161 (defun cli-parse-hash-aux (args cli-opts)
162 (let ((ret (make-hash-table :test #'equal)))
163 (mapcar #'(lambda (arg val)
164 (setf (gethash (abbr->full-opt-name arg cli-opts) ret) val))
165 (mapcar #'opt-name args)
166 (mapcar #'opt-values args))
167 ret))
168
169
170 (defun coalesce-options (args)
171 "Will convert a list of the form (\"--option-name=val1[,]\"
172 \"val2[,]\" \" ... \"valn\" ...) to a list of the form
173 \(\"--option-name=val1 val2 val3\" ...)."
174 (coalesce-options-aux args nil))
175 (defun coalesce-options-aux (args results)
176 "Helper for coalesce-options."
177 (cond ((or (endp args)
178 (endp (cdr args))) (nreverse (cons (car args) results)))
179 ((and (opt-p (first args))
180 (not (opt-p (second args))))
181 (coalesce-options-aux
182 (cons (concatenate 'string
183 (first args)
184 " "
185 (second args))
186 (cddr args))
187 results))
188 (t (coalesce-options-aux (cdr args) (cons (car args) results)))))
189
190 (defun opt-name (opt)
191 "Extract the name of an option: for example \"opt1\" is the name
192 from \"--opt1=val1\". Will return the argument if it is neither."
193 (cond ((abbr-opt-p opt)
194 (subseq opt 1 (end-opt-name opt)))
195 ((full-opt-p opt)
196 (subseq opt 2 (end-opt-name opt)))
197 (t opt)))
198
199 (defun end-opt-name (opt)
200 "Returns the index of the end of the option-name. For example,
201 end-opt-name would return 6 for the option \"--opt1=val1\""
202 (let ((equal-pos (search "=" opt))
203 (space-pos (search " " opt)))
204 (cond ((and equal-pos space-pos) (min equal-pos space-pos))
205 ((or equal-pos space-pos) (or equal-pos space-pos))
206 (t (length opt)))))
207
208 (defun abbr->full-opt-name (opt cli-opts)
209 "Converts an abbreviated option (i.e. \"o\") to its corresponding full
210 option name. Returns the argument if no conversion is performed."
211 (cond ((endp cli-opts) opt)
212 ((equal opt (cli-option-abbr (car cli-opts)))
213 (cli-option-full (car cli-opts)))
214 ((equal opt (cli-option-full (car cli-opts)))
215 opt)
216 (t (abbr->full-opt-name opt (cdr cli-opts)))))
217
218 (defun to-full-opt-names (cl-args cli-opts)
219 "Converts any abbreviated option list of command-line options to the
220 full option name."
221 (let ((result nil)
222 (cli-short-opts (mapcar #'cli-option-abbr cli-opts)))
223 (dolist (obj cl-args)
224 (if (member (car obj) cli-short-opts :test #'string-equal)
225 (push (cons (abbr->full-opt-name (car obj) cli-opts)
226 (cdr obj))
227 result)
228 (push obj result)))
229 (nreverse result)))
230
231 (defun to-full-opt-name (argname cli-opts)
232 "Convert an option name to the full one, if necessary. Change \"o\"
233 to \"outfile\", for example."
234 (dolist (cli-opt cli-opts)
235 (when (string= argname (cli-option-abbr cli-opt))
236 (return (cli-option-full cli-opt)))))
237
238 (defun opt-values (opt)
239 "Extract the values of an option: for example \"val1\" is the value
240 from \"--opt1=val1\". If no values are specified, this function
241 returns nil."
242 (let ((opt (string-trim '(#\Space) opt))
243 (start (or (search "=" opt) (search " " opt))))
244 (if start
245 ;; separate entries by *option-value-sep*
246 (string-tokenize (subseq opt (1+ start)) (list *option-value-sep* ","))
247 nil)))
248
249
250
251 ;; The distinction between whether an option is abbreviated or full
252 ;; doesn't really matter (as far as getting the names and the
253 ;; corresponding values), but it does matter for checking that options
254 ;; are given in the correct form (i.e. -o=val instead of --o=val for
255 ;; short options, and --thing=val instead of -thing=val for long
256 ;; options).
257 (defun opt-p (opt)
258 "Evaluates to true if opt is an abbreviated or a full option."
259 (or (abbr-opt-p opt)
260 (full-opt-p opt)))
261
262 (defun abbr-opt-p (opt)
263 "Test whether opt is a short option of the form \"-o[=val]\""
264 (and (stringp opt)
265 (>= (length opt) 2)
266 (equal (elt opt 0) *single-dash*)
267 (<= (end-opt-name opt) 2)))
268
269 (defun full-opt-p (opt)
270 "Test whether opt is a long option of the form \"--opt[=val]\""
271 (and (stringp opt)
272 (>= (length opt) 4)
273 (equal (subseq opt 0 (length *double-dash*)) *double-dash*)
274 (> (end-opt-name opt) 3)))
275
276 ;;; STRING-TOKENIZE
277
278 (defun string-tokenize (str val-separators &key (include-separators nil))
279 "Breaks up a given string into string components by splitting
280 the string every time an element of val-separator is
281 encountered. Returns a list of strings, which are all the
282 tokens. If include-separators is non-nil, the separators
283 themselves will be included in the parse."
284 (string-tokenize-aux str val-separators nil include-separators))
285 (defun string-tokenize-aux (str val-separators vals include-separators)
286 "Helper for string-tokenize."
287 ;; the if in the return clause takes care of the extra delimeter
288 ;; variable consed onto the end of the list. This implementation is
289 ;; cleaner than the alternative (which is to keep around a variable
290 ;; which will allow the function to distinguish between the
291 ;; first-time it's called, and the rest of the times it's called.
292 (cond ((null str) (if include-separators
293 (remove-if #'(lambda (item) (equal "" item))
294 (butlast (nreverse vals)))
295 (remove-if #'(lambda (item) (equal "" item))
296 (nreverse vals))))
297 (include-separators
298 (multiple-value-bind (first separator)
299 (st-first-val str val-separators)
300 (string-tokenize-aux (st-rest-of str val-separators)
301 val-separators
302 (cons separator
303 (cons first vals))
304 include-separators)))
305 (t (string-tokenize-aux (st-rest-of str val-separators)
306 val-separators
307 (cons (st-first-val str val-separators) vals)
308 include-separators))))
309 (defun st-first-val (str val-separators)
310 "Returns the first token by parsing str. Analagous to car, but for the
311 string tokenizer, instead of for lists."
312 (let ((best-idx (st-closest-val str val-separators)))
313 (values (subseq str 0 best-idx)
314 (unless (equal (length str) best-idx)
315 (subseq str best-idx (1+ best-idx))))))
316 (defun st-rest-of (str val-separators)
317 "Returns the rest of the string, not including the first
318 token. Analagous to cdr, but for the string tokenizer, instead of for
319 lists."
320 (let* ((str-length (length str))
321 (best-idx (st-closest-val str val-separators)))
322 (if (equal str-length best-idx)
323 nil
324 (subseq str (1+ best-idx)))))
325 (defun st-closest-val (str val-separators)
326 "Returns the character in the string which both matches any of the
327 val-separators and minimizes the distance between it and the index 0
328 of the string. If there is no match, returns the length of the
329 string."
330 (let* ((str-length (length str))
331 (best-idx str-length)
332 (sep-match nil))
333 (mapc #'(lambda (separator)
334 (let ((search-result (search separator str)))
335 (unless (null search-result)
336 (when (< search-result best-idx)
337 (setf best-idx search-result)
338 (setf sep-match separator)))))
339 val-separators)
340 best-idx))
341
342
343 (pushnew :cli-parser *features*)
344
345 ;;;; EOF

  ViewVC Help
Powered by ViewVC 1.1.5