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

Contents of /meta-cvs/F-233AD6EEE14894A7303F09519A2AB734

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.48 - (show annotations)
Mon Jul 1 20:47:31 2002 UTC (11 years, 9 months ago) by kaz
Branch: MAIN
Changes since 1.47: +5 -0 lines
Adding purge command.

* mcvs-main.lisp (*purge-options*): New constant.
(*mcvs-command-table*): New entry.
(*usage*): Update.

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

  ViewVC Help
Powered by ViewVC 1.1.5