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

Contents of /meta-cvs/F-9E93CACBDB115633C66D0EF9B052C490

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.7 - (hide annotations)
Sun Mar 10 02:02:49 2002 UTC (12 years, 1 month ago) by kaz
Branch: MAIN
CVS Tags: mcvs-0-7
Changes since 1.6: +18 -0 lines
New --nometa command line option.

* mcvs-main.lisp (*cvs-options*): Add "nometa" to list.
(mcvs-execute): Filter global options to recognize
Meta-CVS-specific ones.

* options.lisp (*nometa-option*): New special variable.
(filter-global-options): New function.

* generic.lisp (mcvs-generic): Honor *nometa-option* special
variable.
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 kaz 1.7 (defvar *nometa-option* nil
8     "This variable controls whether or not certain Meta-CVS operations
9     also include the metafiles in the of files that are operated upon.
10     It is set by the nometa command line option.")
11    
12 kaz 1.1 (defun parse-opt (arguments options options-with-args program-name)
13     "Parses out command line options from the specified argument list.
14     The program-name parameter is a string representing the program name,
15     used for formatting error messages. The arguments parameter is a list of
16     strings. The options parameter is a sequence of strings representing options
17     without arguments. The options-with-args parameter is a sequence of options
18     that take one argument. Options which are one letter long can combine after a
19     single dash. Options which are two or more letters long are assumed to be long
20     options, they are recognized after two dashes and not clump. The string --
21     means no more options. This function returns two values. The first is a list
22     of lists representing the parsed out options. Each list has the option string
23     in the first position. If there is a second element, it is the argument. The
24     second value is the remaining arguments after the last option. An error
25     condition is raised if there is an unrecognized option, or if a required
26     parameter is missing."
27     (let (parsed-options)
28     (flet ((process-option (option)
29     (cond
30     ((find option options :test #'string=)
31     (push (list option) parsed-options))
32     ((find option options-with-args :test #'string=)
33     (when (endp arguments)
34 kaz 1.6 (error "~a: option ~a requires parameter."
35 kaz 1.1 program-name option))
36     (push (list option (first arguments)) parsed-options)
37     (setf arguments (rest arguments)))
38 kaz 1.6 (t (error "~a: unknown option \"~a\"."
39 kaz 1.5 program-name option))))
40     (process-long-option (option)
41     (let ((equals-pos (position #\= option))
42     option-name arg)
43     (if equals-pos
44     (progn (setf option-name (subseq option 0 equals-pos))
45     (setf arg (subseq option (1+ equals-pos))))
46     (setf option-name option))
47     (cond
48     ((find option-name options :test #'string=)
49     (when arg
50 kaz 1.6 (error "~a: option ~a takes no parameter."
51 kaz 1.5 program-name option-name))
52     (push (list option-name) parsed-options))
53     ((find option-name options-with-args :test #'string=)
54     (when (not arg)
55 kaz 1.6 (error "~a: option ~a requires parameter."
56 kaz 1.5 program-name option-name))
57     (push (list option-name arg) parsed-options))
58 kaz 1.6 (t (error "~a: unknown option \"~a\"."
59 kaz 1.5 program-name option-name))))))
60 kaz 1.1 (loop
61     (when (endp arguments) (return))
62     (let ((argument (first arguments)))
63     (setf arguments (rest arguments))
64     (cond
65     ((string= argument "--") (return))
66     ((and (> (length argument) 2) (string= (subseq argument 0 2) "--"))
67     ;; long option
68 kaz 1.5 (process-long-option (subseq argument 2)))
69 kaz 1.1 ((and (> (length argument) 1) (char-equal (char argument 0) #\-))
70     ;; short options
71     (let ((options (subseq argument 1))
72     (saved-arglist arguments))
73 kaz 1.2 ;; for all option letters but the last, pretend that
74 kaz 1.4 ;; there is exactly one remaining argument, which
75     ;; consists of the remaining suffix of the options.
76 kaz 1.1 (dotimes (i (length options))
77 kaz 1.4 (cond
78     ((= i (1- (length options)))
79     (setf arguments saved-arglist)
80     (process-option (subseq options i (1+ i))))
81     (t (setf arguments (list (subseq options (1+ i))))
82     (process-option (subseq options i (1+ i)))
83     ;; If process-option consumes our arguments,
84     ;; bail the loop.
85     (when (endp arguments)
86     (setf arguments saved-arglist)
87     (return)))))))
88 kaz 1.1 (t (push argument arguments) (return))))))
89     (values (nreverse parsed-options) arguments)))
90    
91     (defun format-opt (options)
92     "Convert list of options as produced by parse-opt back into a list
93     of strings."
94     (mapcan #'(lambda (option-list)
95     (let ((option (first option-list))
96     (arg (rest option-list)))
97     (if (> (length option) 1)
98     (cons (format nil "--~a" option) arg)
99     (cons (format nil "-~a" option) arg)))) options))
100 kaz 1.7
101     (defun filter-global-options (opts)
102     "Processes and removes any Meta-CVS-specific options."
103     (mapcan #'(lambda (opt-item)
104     (let ((option (first opt-item))
105     (argument (second opt-item)))
106     (declare (ignore argument))
107     (cond
108     ((string= option "nometa")
109     (setf *nometa-option* t)
110     nil)
111     (t (list opt-item)))))
112     opts))

  ViewVC Help
Powered by ViewVC 1.1.5