/[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.13 by kaz, Sat Oct 5 18:09:48 2002 UTC revision 1.13.2.4 by kaz, Fri Dec 27 23:43:42 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")
10  (provide "options")  (provide "options")
11    
12    (defvar *print-usage* nil)
13  (defvar *nometa-option* nil)  (defvar *nometa-option* nil)
14  (defvar *meta-option* nil)  (defvar *meta-option* nil)
15  (defvar *metaonly-option* nil)  (defvar *metaonly-option* nil)
16    (defvar *dry-run-option* nil)
17    
18  (defun option-spec-expand (num-args string-list)  (defun option-spec-expand (num-args string-list)
19    (mapcar #'(lambda (string) (list string num-args))    (mapcar #'(lambda (string) (list string num-args))
# Line 86  of strings." Line 90  of strings."
90                    (cons (format nil "--~a" option) arg)                    (cons (format nil "--~a" option) arg)
91                    (cons (format nil "-~a" option) arg)))) options))                    (cons (format nil "-~a" option) arg)))) options))
92    
93  (defun filter-global-options (opts)  (defun filter-mcvs-options (opts)
94  "Processes and removes any Meta-CVS-specific options."  "Processes and removes any Meta-CVS-specific options."
95    (find-bind (:test #'string= :key #'first)    (find-bind (:test #'string= :key #'first)
96               (remainder (meta "meta")               (remainder (meta "meta")
# Line 109  of strings." Line 113  of strings."
113        (et (setf *mcvs-error-treatment* :terminate))        (et (setf *mcvs-error-treatment* :terminate))
114        (ec (setf *mcvs-error-treatment* :continue)))        (ec (setf *mcvs-error-treatment* :continue)))
115      remainder))      remainder))
116    
117    (defun process-cvs-options (opts)
118    "Take care of any CVS options that must also be interpreted by Meta-CVS."
119      (find-bind (:test #'string= :key #'first)
120                 ((help-long "help") (help "H") (quiet "q")
121                  (very-quiet "Q") (version "v") (version-long "version")
122                  (editor "e") (interpret-file "i") (dry-run "n"))
123                 opts
124        (when (or help-long help)
125          (setf *print-usage* t))
126        (when (or version version-long)
127          (let* ((vers (split-words "$Name$" "$:- "))
128                 (major (third vers))
129                 (minor (fourth vers))
130                 (patch (fifth vers)))
131            (if (and major minor patch)
132              (format t "Meta-CVS version ~a.~a.~a (c) 2002 Kaz Kylheku~%"
133                      major minor patch)
134              (format t "Meta-CVS unknown version (c) 2002 Kaz Kylheku~%"))
135            (throw 'mcvs-terminate nil)))
136        (when editor
137          (setf *mcvs-editor* (second editor)))
138        (cond
139          (very-quiet (setf *mcvs-chatter-level* *mcvs-silent*))
140          (quiet (setf *mcvs-chatter-level* *mcvs-terse*)))
141        (when dry-run
142          (setf *dry-run-option* t))
143        (when interpret-file
144          (load (second interpret-file))
145          (throw 'mcvs-terminate nil)))
146      opts)
147    
148    (defun filter-global-options (opts)
149      (process-cvs-options (filter-mcvs-options opts)))
150    
151    (defmacro honor-dry-run (vars &rest forms)
152      `(cond
153         (*dry-run-option*
154           (chatter-debug
155             "Because of -n option, not executing ~s with bindings ~s.~%"
156             ',forms
157             (list ,@(mapcar #'(lambda (var) `(list ',var ,var)) vars))))
158         (t ,@forms)))

Legend:
Removed from v.1.13  
changed lines
  Added in v.1.13.2.4

  ViewVC Help
Powered by ViewVC 1.1.5