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

Contents of /meta-cvs/F-9E93CACBDB115633C66D0EF9B052C490

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.12 - (hide annotations)
Sat Sep 21 21:07:49 2002 UTC (11 years, 6 months ago) by kaz
Branch: MAIN
CVS Tags: mcvs-0-96
Changes since 1.11: +7 -1 lines
* code/mcvs-main.lisp (*options*): New variable. Gives
scripts access to to some global options.  The *args* variable now
holds only the remaining arguments after the options.
(mcvs-execute): Sets up *args* and *options* accordingly.
No longer parses out the --error-continue and --error-terminate
options.

* code/options.lisp (filter-global-options): The handling of
--error-continue and --error-terminate is done here. This is
the place to handle options that must be removed (not passed
down to CVS) and which do not trigger immediate actions in
mcvs-execute.
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 kaz 1.9 (require "find-bind")
6 kaz 1.10 (require "split")
7 kaz 1.12 (require "error")
8 kaz 1.1 (provide "options")
9    
10 kaz 1.9 (defvar *nometa-option* nil)
11     (defvar *meta-option* nil)
12     (defvar *metaonly-option* nil)
13 kaz 1.7
14 kaz 1.10 (defun option-spec-expand (num-args string-list)
15     (mapcar #'(lambda (string) (list string num-args))
16     string-list))
17    
18     (defmacro option-spec (&rest option-specs)
19     `(append ,@(mapcar #'(lambda (spec)
20     (destructuring-bind (number word &rest strings) spec
21     (when (not (string= (symbol-name word) "ARG"))
22     (error "OPTIONS: word \"ARG\" expected."))
23     `(option-spec-expand ,number ',strings)))
24     option-specs)))
25    
26     (defmacro define-option-constant (var &rest option-specs)
27     `(defconstant ,var (option-spec ,@option-specs)))
28    
29     (defun parse-opt (arguments option-spec)
30     (flet ((process-option (arg)
31     (let* ((split-opt (split-fields arg #(#\=)))
32     (opt-name (first split-opt))
33     (opt-arg (second split-opt))
34     (spec (find opt-name option-spec
35     :test #'string=
36     :key #'first)))
37     (when (null spec)
38     (error "mcvs: unknown option ~a." opt-name))
39     (when opt-arg
40     (push opt-arg arguments))
41     (let ((num-req-params (second spec))
42     (opt-args ()))
43     (dotimes (i num-req-params)
44     (let ((opt-arg (pop arguments)))
45     (when (null opt-arg)
46 kaz 1.11 (error "mcvs: option ~a requires ~a parameter~:p."
47 kaz 1.10 opt-name num-req-params))
48     (push opt-arg opt-args)))
49     (cons opt-name (nreverse opt-args))))))
50     (let ((parsed-options ()))
51 kaz 1.1 (loop
52 kaz 1.10 (if (null arguments)
53     (return))
54     (let ((arg (pop arguments)))
55     (cond
56     ((string= arg "--")
57     (return))
58     ((and (> (length arg) 2) (string= (subseq arg 0 2) "--"))
59     (push (process-option (subseq arg 2)) parsed-options))
60     ((and (> (length arg) 1) (char= (char arg 0) #\-))
61     (let ((num-chars (- (length arg) 1))
62     (last-iter (- (length arg) 2)))
63     (dotimes (i num-chars)
64     (let ((option (subseq arg (+ i 1) (+ i 2)))
65     (arg (subseq arg (+ i 2))))
66     (when (< i last-iter)
67     (push arg arguments))
68     (let ((result (process-option option)))
69     (push result parsed-options)
70     (when (and (second result)
71     (/= i (- (length arg) 2)))
72     (return))
73     (when (< i last-iter)
74     (pop arguments)))))))
75     (t (push arg arguments)
76     (return)))))
77     (values (nreverse parsed-options) arguments))))
78    
79 kaz 1.1 (defun format-opt (options)
80     "Convert list of options as produced by parse-opt back into a list
81     of strings."
82     (mapcan #'(lambda (option-list)
83     (let ((option (first option-list))
84     (arg (rest option-list)))
85     (if (> (length option) 1)
86     (cons (format nil "--~a" option) arg)
87     (cons (format nil "-~a" option) arg)))) options))
88 kaz 1.7
89     (defun filter-global-options (opts)
90     "Processes and removes any Meta-CVS-specific options."
91 kaz 1.9 (find-bind (:test #'string= :key #'first)
92     (remainder (meta "meta")
93     (metaonly "metaonly")
94 kaz 1.12 (nometa "nometa")
95     (ec "error-continue")
96     (et "error-terminate"))
97 kaz 1.9 opts
98     (when (and meta nometa)
99     (error "mcvs: cannot specify both --nometa and --meta"))
100     (when (and metaonly nometa)
101     (error "mcvs: cannot specify both --nometa and --metaonly"))
102     (setf *meta-option* meta)
103     (setf *metaonly-option* metaonly)
104     (setf *nometa-option* nometa)
105 kaz 1.12 (cond
106     (et (setf *mcvs-error-treatment* :terminate))
107     (ec (setf *mcvs-error-treatment* :continue)))
108 kaz 1.9 remainder))

  ViewVC Help
Powered by ViewVC 1.1.5