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

Contents of /meta-cvs/F-9E93CACBDB115633C66D0EF9B052C490

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.11 - (hide annotations)
Sun Sep 8 01:34:54 2002 UTC (11 years, 7 months ago) by kaz
Branch: MAIN
CVS Tags: mcvs-0-24, mcvs-0-95
Changes since 1.10: +1 -1 lines
Eliminate inappropriate pluralization in messages.

* code/grab.lisp (mcvs-grab): Use ~:p to substitute a 's'
if the parameter is other than 1.

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

  ViewVC Help
Powered by ViewVC 1.1.5