/[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 - (show 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 ;;; This source file is part of the Meta-CVS program,
2 ;;; which is distributed under the GNU license.
3 ;;; Copyright 2002 Kaz Kylheku
4
5 (provide "options")
6
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 (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 (error "~a: option ~a requires parameter."
35 program-name option))
36 (push (list option (first arguments)) parsed-options)
37 (setf arguments (rest arguments)))
38 (t (error "~a: unknown option \"~a\"."
39 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 (error "~a: option ~a takes no parameter."
51 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 (error "~a: option ~a requires parameter."
56 program-name option-name))
57 (push (list option-name arg) parsed-options))
58 (t (error "~a: unknown option \"~a\"."
59 program-name option-name))))))
60 (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 (process-long-option (subseq argument 2)))
69 ((and (> (length argument) 1) (char-equal (char argument 0) #\-))
70 ;; short options
71 (let ((options (subseq argument 1))
72 (saved-arglist arguments))
73 ;; for all option letters but the last, pretend that
74 ;; there is exactly one remaining argument, which
75 ;; consists of the remaining suffix of the options.
76 (dotimes (i (length options))
77 (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 (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
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