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

  ViewVC Help
Powered by ViewVC 1.1.5