/[meta-cvs]/meta-cvs/F-233AD6EEE14894A7303F09519A2AB734
ViewVC logotype

Contents of /meta-cvs/F-233AD6EEE14894A7303F09519A2AB734

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.37 - (show annotations)
Thu Mar 14 19:03:34 2002 UTC (12 years, 1 month ago) by kaz
Branch: MAIN
CVS Tags: mcvs-0-9
Changes since 1.36: +1 -1 lines
Update takes file arguments now.

* update.lisp (mcvs-update): If filename arguments are given, then
just call mcvs-generic to do the work, but suppress the operation on
meta files. If no filename arguments are given, then update everything.
If the -p option is present, no synchronization is needed, before or
after.
(mcvs-update-wrapper): Pass command arguments down to mcvs-update.

* mcvs-main.lisp (*update-options*): Add "p" option.

* generic.lisp (mcvs-generic): New keyword parameter need-sync-after,
a generalized boolean which can tell the function to do a
mapping-synchronize after executing the CVS command.
1 ;;; This source file is part of the Meta-CVS program,
2 ;;; which is distributed under the GNU license.
3 ;;; Copyright 2002 Kaz Kylheku
4
5 (require "import")
6 (require "checkout")
7 (require "add")
8 (require "remove")
9 (require "move")
10 (require "update")
11 (require "filt")
12 (require "generic")
13 (require "convert")
14 (require "split")
15 (require "restart")
16 (require "error")
17 (require "options")
18 (require "find-bind")
19 (provide "mcvs-main")
20
21 (defconstant *cvs-options*
22 '("H" "help" "Q" "q" "r" "w" "l" "n" "t" "v" "f" "version"
23 "nometa" "error-continue" "error-terminate"))
24
25 (defconstant *cvs-options-arg* '("T" "e" "d" "r" "z" "s"))
26
27 (defconstant *import-options* '(("d") ("k" "I" "b" "m" "W")))
28 (defconstant *checkout-options* '(("A" "N" "f") ("r" "D" "d" "k" "j")))
29 (defconstant *add-options* '(("R") ("k" "m")))
30 (defconstant *remove-options* '(("R") ()))
31 (defconstant *update-options* '(("A" "f" "p") ("k" "r" "D" "j" "I" "W")))
32 (defconstant *commit-options* '(("f") ("F" "m" "r")))
33 (defconstant *diff-options* '(("a" "b" "B" "brief" "c" "d" "e" "ed"
34 "expand-tabs" "f" "forward-ed" "H" "i"
35 "ignore-all-space" "ignore-blank-lines"
36 "ignore-case" "ignore-space-change"
37 "initial-tab" "l" "left-column" "minimal"
38 "n" "N" "new-file" "p" "P" "--paginate" "q"
39 "rcs" "report-identical-files" "s"
40 "show-c-function" "side-by-side"
41 "speed-large-files" "suppress-common-lines"
42 "t" "T" "text" "u" "unidirectional-new-file"
43 "w" "y")
44 ("C" "context" "D" "F" "horizon-lines" "ifdef"
45 "ignore-matching-lines" "L" "label"
46 "line-format" "new-group-format"
47 "new-line-format" "old-group-format"
48 "old-line-format" "r" "show-function-line"
49 "unchanged-group-format" "unchanged-line-format"
50 "U" "unified" "W" "width")))
51 (defconstant *tag-options* '(("l" "d" "f" "b" "F" "c") ("r" "D")))
52 (defconstant *log-options* '(("R" "h" "t" "N" "b") ("r" "d" "s" "w")))
53 (defconstant *status-options* '(("v") ()))
54 (defconstant *annotate-options* '(("f") ("r" "D")))
55 (defconstant *filt-options* '(() ("r" "D")))
56 (defconstant *convert-options* '(() ()))
57
58 (defconstant *mcvs-command-table*
59 `(("import" ,#'mcvs-import-wrapper ,@*import-options*)
60 ("checkout" ,#'mcvs-checkout-wrapper ,@*checkout-options*)
61 ("co" ,#'mcvs-checkout-wrapper ,@*checkout-options*)
62 ("add" ,#'mcvs-add-wrapper ,@*add-options*)
63 ("remove" ,#'mcvs-remove-wrapper ,@*remove-options*)
64 ("rm" ,#'mcvs-remove-wrapper ,@*remove-options*)
65 ("move" ,#'mcvs-move-wrapper nil nil)
66 ("mv" ,#'mcvs-move-wrapper nil nil)
67 ("update" ,#'mcvs-update-wrapper ,@*update-options*)
68 ("up" ,#'mcvs-update-wrapper ,@*update-options*)
69 ("commit" ,#'mcvs-commit-wrapper ,@*commit-options*)
70 ("ci" ,#'mcvs-commit-wrapper ,@*commit-options*)
71 ("diff" ,#'mcvs-diff-wrapper ,@*diff-options*)
72 ("tag" ,#'mcvs-tag-wrapper ,@*tag-options*)
73 ("log" ,#'mcvs-log-wrapper ,@*log-options*)
74 ("status" ,#'mcvs-status-wrapper ,@*status-options*)
75 ("stat" ,#'mcvs-status-wrapper ,@*status-options*)
76 ("annotate" ,#'mcvs-annotate-wrapper ,@*annotate-options*)
77 ("filt" ,#'mcvs-filt-wrapper ,@*filt-options*)
78 ("fi" ,#'mcvs-filt-wrapper ,@*filt-options*)
79 ("convert" ,#'mcvs-convert-wrapper ,@*convert-options*)))
80
81 (defconstant *usage*
82 "Meta-CVS command syntax:
83
84 mcvs global-options command command-options-and-arguments
85
86 Global options:
87
88 -H --help Print this help and terminate. If a command is specified,
89 help specific to that command is printed instead.
90 -Q Very quiet, generate output only for serious problems. (*)
91 -q Somewhat quiet, some informational messages suppresed. (*)
92 -r Make working files read-only. (@)
93 -w Make new working files read-write (default). (@)
94 -l Do not log cvs command in command history, but execute
95 it anyway. (@)
96 -t Trace CVS execution. (@)
97 -v --version Display version information and terminate.
98 -f CVS not to read ~/.cvsrc file. (@)
99 --nometa Do not add Meta-CVS metafiles to the set of
100 files to commit, diff, stat, log or annotate.
101 --error-continue Instead of interactive error handling, automatically
102 continue all continuable errors.
103 --error-terminate Terminate without cleanup when an error happens instead
104 of interactive error handling (use with care).
105 -T tempdir Place temporary files in tempdir. (@)
106 -e editor Edit messages with editor. (*)
107 -d root Specify CVSROOT. (@)
108 -z gzip-level Specify compression level. (@)
109
110 Notes: (*) option processed by Meta-CVS and passed to CVS too.
111 (@) option merely passed to CVS.
112
113 Commands:
114
115 import Create new project from an existing file tree.
116 checkout (co) Retrieve a Meta-CVS project from CVS and build
117 working copy.
118 add Place files (or directories with add -R) under
119 version control.
120 remove (rm) Remove files or directories.
121 move (mv) Rename files and directories.
122 update (up) Incorporate latest changes from repository into
123 working copy.
124 commit (ci) Incorporate outstanding changes in the working copy
125 into the repository.
126 diff Compute differences between files in the working copy
127 and the repository or between revisions in the repository.
128 tag Associate a symbolic name with file revisions to create
129 an identifiable baseline. By default, tags the
130 revisions that were last synchronized with the
131 directory. A branch is created using tag -b.
132 log Display log information for files.
133 status (stat) Show current status of files.
134 annotate Perform a detailed analysis of files, showing the
135 version information about every individual line of text.
136 filt (fi) Act as a text filter, which converts Meta-CVS F- file
137 names to readable paths, according to the current mapping.
138 convert Convert a CVS module to a Meta-CVS project. This requires
139 filesystem-level access to the repository. This is
140 currently an experimental command that is known not
141 to work 100%.")
142
143 (defun mcvs-execute (args)
144 (handler-bind ((error #'mcvs-error-handler))
145 (multiple-value-bind (global-options global-args)
146 (parse-opt args *cvs-options*
147 *cvs-options-arg* "mcvs")
148 (setf global-options (filter-global-options global-options))
149
150 (find-bind (:test #'string= :key #'first)
151 ((help-long "help") (help "H") (quiet "q")
152 (very-quiet "Q") (version "v") (version-long "version")
153 (editor "e"))
154 global-options
155 (when (or help-long help)
156 (terpri)
157 (write-line *usage*)
158 (terpri)
159 (throw 'mcvs-terminate nil))
160 (when (or version version-long)
161 (let* ((vers (split-words "$Name: $" "$:- "))
162 (major (third vers))
163 (minor (fourth vers)))
164 (if (and major minor)
165 (format t "Meta-CVS version ~a.~a (c) 2002 Kaz Kylheku~%"
166 major minor)
167 (format t "Meta-CVS unknown version (c) 2002 Kaz Kylheku~%"))
168 (throw 'mcvs-terminate nil)))
169 (when editor
170 (setf *editor* (second editor)))
171 (cond
172 (very-quiet (setf *mcvs-chatter-level* *mcvs-silent*))
173 (quiet (setf *mcvs-chatter-level* *mcvs-terse*))
174 (t (setf *mcvs-chatter-level* *mcvs-info*))))
175
176 (when (not (first global-args))
177 (write-line "Meta-CVS requires a command argument.")
178 (write-line "Use mcvs -H to view help.")
179 (throw 'mcvs-terminate nil))
180
181 (let ((command (find (first global-args) *mcvs-command-table*
182 :key #'first
183 :test #'string=)))
184 (when (not command)
185 (error "mcvs: ~a is not a recognized mcvs command."
186 (first global-args)))
187 (destructuring-bind (name func noarg-opts arg-opts) command
188 (declare (ignore name))
189 (find-bind (:test #'string= :key #'first)
190 (global-options (ec "error-continue") (et "error-terminate"))
191 global-options
192 (cond
193 (et (setf *mcvs-error-treatment* :terminate))
194 (ec (setf *mcvs-error-treatment* :continue)))
195
196 (multiple-value-bind (command-options command-args)
197 (parse-opt (rest global-args)
198 noarg-opts arg-opts "mcvs")
199 (funcall func global-options command-options command-args)))))))
200 nil)
201
202 (defun mcvs-debug-shell ()
203 (let ((counter 0)
204 (*mcvs-error-treatment* :decline))
205 (loop
206 (format t "~&mcvs[~a]> " (incf counter))
207 (let ((line (string-trim #(#\space #\tab) (read-line))))
208 (restart-case
209 (cond
210 ((zerop (length line)))
211 ((string-equal line "exit")
212 (return-from mcvs-debug-shell))
213 ((char-equal (char line 0) #\!)
214 (print (eval (read-from-string (subseq line 1)))))
215 (t (mcvs-execute (split-words line #(#\space #\tab)))))
216 (debug () :report "Return to mcvs debug shell"
217 (terpri)))))))
218
219 #+clisp
220 (defun mcvs ()
221 (exit (catch 'mcvs-terminate (or (mcvs-execute ext:*args*)
222 *mcvs-errors-occured-p*))))

  ViewVC Help
Powered by ViewVC 1.1.5