/[meta-cvs]/meta-cvs/F-9E93CACBDB115633C66D0EF9B052C490
ViewVC logotype

Contents of /meta-cvs/F-9E93CACBDB115633C66D0EF9B052C490

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.6 - (hide annotations)
Sun Feb 10 05:09:16 2002 UTC (12 years, 2 months ago) by kaz
Branch: MAIN
CVS Tags: mcvs-0-6, mcvs-0-5
Changes since 1.5: +5 -5 lines
Remove spurious newlines from error messages.
1 kaz 1.3 ;;; This source file is part of the Meta-CVS program,
2 kaz 1.1 ;;; which is distributed under the GNU license.
3     ;;; Copyright 2002 Kaz Kylheku
4    
5     (provide "options")
6    
7     (defun parse-opt (arguments options options-with-args program-name)
8     "Parses out command line options from the specified argument list.
9     The program-name parameter is a string representing the program name,
10     used for formatting error messages. The arguments parameter is a list of
11     strings. The options parameter is a sequence of strings representing options
12     without arguments. The options-with-args parameter is a sequence of options
13     that take one argument. Options which are one letter long can combine after a
14     single dash. Options which are two or more letters long are assumed to be long
15     options, they are recognized after two dashes and not clump. The string --
16     means no more options. This function returns two values. The first is a list
17     of lists representing the parsed out options. Each list has the option string
18     in the first position. If there is a second element, it is the argument. The
19     second value is the remaining arguments after the last option. An error
20     condition is raised if there is an unrecognized option, or if a required
21     parameter is missing."
22     (let (parsed-options)
23     (flet ((process-option (option)
24     (cond
25     ((find option options :test #'string=)
26     (push (list option) parsed-options))
27     ((find option options-with-args :test #'string=)
28     (when (endp arguments)
29 kaz 1.6 (error "~a: option ~a requires parameter."
30 kaz 1.1 program-name option))
31     (push (list option (first arguments)) parsed-options)
32     (setf arguments (rest arguments)))
33 kaz 1.6 (t (error "~a: unknown option \"~a\"."
34 kaz 1.5 program-name option))))
35     (process-long-option (option)
36     (let ((equals-pos (position #\= option))
37     option-name arg)
38     (if equals-pos
39     (progn (setf option-name (subseq option 0 equals-pos))
40     (setf arg (subseq option (1+ equals-pos))))
41     (setf option-name option))
42     (cond
43     ((find option-name options :test #'string=)
44     (when arg
45 kaz 1.6 (error "~a: option ~a takes no parameter."
46 kaz 1.5 program-name option-name))
47     (push (list option-name) parsed-options))
48     ((find option-name options-with-args :test #'string=)
49     (when (not arg)
50 kaz 1.6 (error "~a: option ~a requires parameter."
51 kaz 1.5 program-name option-name))
52     (push (list option-name arg) parsed-options))
53 kaz 1.6 (t (error "~a: unknown option \"~a\"."
54 kaz 1.5 program-name option-name))))))
55 kaz 1.1 (loop
56     (when (endp arguments) (return))
57     (let ((argument (first arguments)))
58     (setf arguments (rest arguments))
59     (cond
60     ((string= argument "--") (return))
61     ((and (> (length argument) 2) (string= (subseq argument 0 2) "--"))
62     ;; long option
63 kaz 1.5 (process-long-option (subseq argument 2)))
64 kaz 1.1 ((and (> (length argument) 1) (char-equal (char argument 0) #\-))
65     ;; short options
66     (let ((options (subseq argument 1))
67     (saved-arglist arguments))
68 kaz 1.2 ;; for all option letters but the last, pretend that
69 kaz 1.4 ;; there is exactly one remaining argument, which
70     ;; consists of the remaining suffix of the options.
71 kaz 1.1 (dotimes (i (length options))
72 kaz 1.4 (cond
73     ((= i (1- (length options)))
74     (setf arguments saved-arglist)
75     (process-option (subseq options i (1+ i))))
76     (t (setf arguments (list (subseq options (1+ i))))
77     (process-option (subseq options i (1+ i)))
78     ;; If process-option consumes our arguments,
79     ;; bail the loop.
80     (when (endp arguments)
81     (setf arguments saved-arglist)
82     (return)))))))
83 kaz 1.1 (t (push argument arguments) (return))))))
84     (values (nreverse parsed-options) arguments)))
85    
86     (defun format-opt (options)
87     "Convert list of options as produced by parse-opt back into a list
88     of strings."
89     (mapcan #'(lambda (option-list)
90     (let ((option (first option-list))
91     (arg (rest option-list)))
92     (if (> (length option) 1)
93     (cons (format nil "--~a" option) arg)
94     (cons (format nil "-~a" option) arg)))) options))

  ViewVC Help
Powered by ViewVC 1.1.5