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

Contents of /meta-cvs/F-233AD6EEE14894A7303F09519A2AB734

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.46 - (show annotations)
Tue Jun 25 23:39:19 2002 UTC (11 years, 9 months ago) by kaz
Branch: MAIN
CVS Tags: old-convert-hacking-branch~branch-point, mcvs-0-15
Branch point for: old-convert-hacking-branch
Changes since 1.45: +6 -0 lines
New feature: grab command. Takes snapshot of code and imports
it to a branch, trying to determine which of the added and
removed files are actually moves.

* grab.lisp: New file.
(read-word-hash, word-hash-file, correlate, added-removed,
move-candidates, mcvs-grab, mcvs-grab-wrapper): New functions.

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

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

  ViewVC Help
Powered by ViewVC 1.1.5