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

Contents of /meta-cvs/F-9E93CACBDB115633C66D0EF9B052C490

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.9 - (show annotations)
Sat Jun 29 14:15:25 2002 UTC (11 years, 9 months ago) by kaz
Branch: MAIN
CVS Tags: mcvs-0-20, symlink-branch~branch-point, mcvs-0-22, mcvs-0-23, partial-sandbox-branch~branch-point, mcvs-0-21, partial-sandbox-branch~merged-to-HEAD-0, mcvs-0-16, mcvs-0-17, mcvs-0-19, mcvs-0-18, symlink-branch~merged-to-HEAD-0
Branch point for: symlink-branch, partial-sandbox-branch
Changes since 1.8: +17 -14 lines
* options.lisp (*nometa-option*): Eliminated rid useless docstring.
(*meta-option*): New variable.
(*nometa-option*): New variable.
(filter-global-options): Clean rewrite using find-bind.

* generic.lisp (mcvs-generic): New keyword parameters
default-include-meta-files, need-update-after. Implements new logic
related to the new options. Performs (mapping-update) if
need-update-after is true and metafiles were subject to cvs update.
(mcvs-commit-wrapper): Calls mcvs-generic with
:default-include-meta-files t.

* update.lisp (mcvs-update): No longer overrides the *nometa-option*
special variable. Passes :need-update-after t to mcvs-generic.

* mcvs-main.lisp (*cvs-options*): New options entered into list.
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 (require "find-bind")
6 (provide "options")
7
8 (defvar *nometa-option* nil)
9 (defvar *meta-option* nil)
10 (defvar *metaonly-option* nil)
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 (find-bind (:test #'string= :key #'first)
104 (remainder (meta "meta")
105 (metaonly "metaonly")
106 (nometa "nometa"))
107 opts
108 (when (and meta nometa)
109 (error "mcvs: cannot specify both --nometa and --meta"))
110 (when (and metaonly nometa)
111 (error "mcvs: cannot specify both --nometa and --metaonly"))
112 (setf *meta-option* meta)
113 (setf *metaonly-option* metaonly)
114 (setf *nometa-option* nometa)
115 remainder))

  ViewVC Help
Powered by ViewVC 1.1.5