/[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.3 by kaz, Mon Nov 4 02:07:35 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            (if (and major minor)
131              (format t "Meta-CVS version ~a.~a (c) 2002 Kaz Kylheku~%"
132                      major minor)
133              (format t "Meta-CVS unknown version (c) 2002 Kaz Kylheku~%"))
134            (throw 'mcvs-terminate nil)))
135        (when editor
136          (setf *mcvs-editor* (second editor)))
137        (cond
138          (very-quiet (setf *mcvs-chatter-level* *mcvs-silent*))
139          (quiet (setf *mcvs-chatter-level* *mcvs-terse*)))
140        (when dry-run
141          (setf *dry-run-option* t))
142        (when interpret-file
143          (load (second interpret-file))
144          (throw 'mcvs-terminate nil)))
145      opts)
146    
147    (defun filter-global-options (opts)
148      (process-cvs-options (filter-mcvs-options opts)))
149    
150    (defmacro honor-dry-run (vars &rest forms)
151      `(cond
152         (*dry-run-option*
153           (chatter-debug
154             "Because of -n option, not executing ~s with bindings ~s.~%"
155             ',forms
156             (list ,@(mapcar #'(lambda (var) `(list ',var ,var)) vars))))
157         (t ,@forms)))

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

  ViewVC Help
Powered by ViewVC 1.1.5