source: cl-darcs/trunk/getopt.lisp

Last change on this file was 159, checked in by Magnus Henoch, 14 years ago

Move INVALID-ARGUMENTS condition to getopt.lisp, and use it.

File size: 3.8 KB
Line 
1;;; Copyright (C) 2008 Magnus Henoch
2;;;
3;;; This program is free software; you can redistribute it and/or
4;;; modify it under the terms of the GNU General Public License as
5;;; published by the Free Software Foundation; either version 2 of the
6;;; License, or (at your option) any later version.
7;;;
8;;; This program is distributed in the hope that it will be useful,
9;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
10;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
11;;; General Public License for more details.
12;;;
13;;; You should have received a copy of the GNU General Public License
14;;; along with this program; if not, write to the Free Software
15;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
16
17(in-package :darcs)
18
19(define-condition invalid-arguments (simple-error)
20  ())
21
22;; The option struct describes a command line option.
23(defstruct option
24  ;; keyword for return value of GETOPT
25  (keyword (error "No keyword specified.") :type keyword)
26  ;; short name of one character
27  (short nil :type (or character null))
28  ;; long name
29  (long nil :type (or string null))
30  ;; does it take an argument?  if so, describe the argument type.
31  (arg nil :type (or string null))
32  ;; one-line help string
33  (help (error "No help string specified.") :type string))
34
35(defun getopt (args options &aux parsed leftover)
36  "Process command line ARGS, as specified by OPTIONS.
37ARGS is a list of strings.
38OPTIONS is a list of OPTION structs.
39
40Return two values: a alist of parsed options, and a list of leftover args.
41The keys of the alists are the keywords of the options found, and the
42values are the provided arguments, or T if the option takes no argument."
43  (flet ((what (arg)
44           (cond
45             ((string= arg "--")
46              :pass)
47             ((and (>= (length arg) 2)
48                   (string= arg "--" :end1 2))
49              :long)
50             ((and (>= (length arg) 1)
51                   (string= arg "-" :end1 1))
52              :short)
53             (t
54              nil)))
55         (maybe-get-argument (arg opt &key no-argument)
56           (push (cons (option-keyword opt)
57                       (if (option-arg opt)
58                           (if (or no-argument (null args))
59                               (error 'invalid-arguments
60                                      :format-control "Option ~A requires an argument."
61                                      :format-arguments (list arg))
62                               (pop args))
63                           t))
64                 parsed))
65         (maybe-split-long-option (arg)
66           (let ((equal-pos (position #\= arg)))
67             (if equal-pos
68                 (progn
69                   (push (subseq arg (1+ equal-pos)) args)
70                   (subseq arg 2 equal-pos))
71                 (subseq arg 2)))))
72
73    (loop while args do
74         (ecase (what (car args))
75           (:pass
76            ;; Got "--".  Skip it and return the remaining arguments
77            ;; without checking.
78            (pop args)
79            (return-from getopt (values parsed (append (nreverse leftover) args))))
80
81           (:long
82            ;; Got a long option.  Identify it and retrieve its
83            ;; argument, if any.
84            (let* ((arg (pop args))
85                   (long-option (maybe-split-long-option arg))
86                   (option (find long-option options :key #'option-long :test #'string=)))
87              (unless option
88                (error 'invalid-arguments
89                       :format-control "Unknown long option ~S (none of ~{~S ~})."
90                       :format-arguments (list arg (mapcar #'option-long options))))
91              (maybe-get-argument arg option)))
92
93           (:short
94            ;; Got a string of short options.  Identify them all.
95            (let* ((arg (pop args))
96                   (letters (map 'list #'identity (subseq arg 1))))
97
98              (loop while letters
99                 do
100                   (let* ((letter (pop letters))
101                          (option (find letter options :key #'option-short)))
102                     (unless option
103                       (error 'invalid-arguments
104                              :format-control "Unknown option ~A."
105                              :format-arguments (list letter)))
106                     ;; Only the last short option can have an argument.
107                     (maybe-get-argument letter option 
108                                         :no-argument (not (null letters)))))))
109
110           ((nil)
111            ;; Not an option - leftover args.
112            (push (pop args) leftover))))
113
114    (values parsed (nreverse leftover))))
Note: See TracBrowser for help on using the repository browser.