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

Diff of /meta-cvs/F-9E93CACBDB115633C66D0EF9B052C490

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.14 by kaz, Thu Oct 31 04:06:01 2002 UTC revision 1.15 by kaz, Mon Nov 4 02:09:17 2002 UTC
# Line 2  Line 2 
2  ;;; which is distributed under the GNU license.  ;;; which is distributed under the GNU license.
3  ;;; Copyright 2002 Kaz Kylheku  ;;; Copyright 2002 Kaz Kylheku
4    
5    (require "system")
6    (require "chatter")
7  (require "find-bind")  (require "find-bind")
8  (require "split")  (require "split")
9  (require "error")  (require "error")
# Line 10  Line 12 
12    
13  (in-package "META-CVS")  (in-package "META-CVS")
14    
15    (defvar *print-usage* nil)
16  (defvar *nometa-option* nil)  (defvar *nometa-option* nil)
17  (defvar *meta-option* nil)  (defvar *meta-option* nil)
18  (defvar *metaonly-option* nil)  (defvar *metaonly-option* nil)
19    (defvar *dry-run-option* nil)
20    
21  (defun option-spec-expand (num-args string-list)  (defun option-spec-expand (num-args string-list)
22    (mapcar #'(lambda (string) (list string num-args))    (mapcar #'(lambda (string) (list string num-args))
# Line 89  of strings." Line 93  of strings."
93                    (cons (format nil "--~a" option) arg)                    (cons (format nil "--~a" option) arg)
94                    (cons (format nil "-~a" option) arg)))) options))                    (cons (format nil "-~a" option) arg)))) options))
95    
96  (defun filter-global-options (opts)  (defun filter-mcvs-options (opts)
97  "Processes and removes any Meta-CVS-specific options."  "Processes and removes any Meta-CVS-specific options."
98    (find-bind (:test #'string= :key #'first)    (find-bind (:test #'string= :key #'first)
99               (remainder (meta "meta")               (remainder (meta "meta")
# Line 112  of strings." Line 116  of strings."
116        (et (setf *mcvs-error-treatment* :terminate))        (et (setf *mcvs-error-treatment* :terminate))
117        (ec (setf *mcvs-error-treatment* :continue)))        (ec (setf *mcvs-error-treatment* :continue)))
118      remainder))      remainder))
119    
120    (defun process-cvs-options (opts)
121    "Take care of any CVS options that must also be interpreted by Meta-CVS."
122      (find-bind (:test #'string= :key #'first)
123                 ((help-long "help") (help "H") (quiet "q")
124                  (very-quiet "Q") (version "v") (version-long "version")
125                  (editor "e") (interpret-file "i") (dry-run "n"))
126                 opts
127        (when (or help-long help)
128          (setf *print-usage* t))
129        (when (or version version-long)
130          (let* ((vers (split-words "$Name$" "$:- "))
131                 (major (third vers))
132                 (minor (fourth vers)))
133            (if (and major minor)
134              (format t "Meta-CVS version ~a.~a (c) 2002 Kaz Kylheku~%"
135                      major minor)
136              (format t "Meta-CVS unknown version (c) 2002 Kaz Kylheku~%"))
137            (throw 'mcvs-terminate nil)))
138        (when editor
139          (setf *mcvs-editor* (second editor)))
140        (cond
141          (very-quiet (setf *mcvs-chatter-level* *mcvs-silent*))
142          (quiet (setf *mcvs-chatter-level* *mcvs-terse*)))
143        (when dry-run
144          (setf *dry-run-option* t))
145        (when interpret-file
146          (load (second interpret-file))
147          (throw 'mcvs-terminate nil)))
148      opts)
149    
150    (defun filter-global-options (opts)
151      (process-cvs-options (filter-mcvs-options opts)))
152    
153    (defmacro honor-dry-run (vars &rest forms)
154      `(cond
155         (*dry-run-option*
156           (chatter-debug
157             "Because of -n option, not executing ~s with bindings ~s.~%"
158             ',forms
159             (list ,@(mapcar #'(lambda (var) `(list ',var ,var)) vars))))
160         (t ,@forms)))

Legend:
Removed from v.1.14  
changed lines
  Added in v.1.15

  ViewVC Help
Powered by ViewVC 1.1.5