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

Contents of /meta-cvs/F-233AD6EEE14894A7303F09519A2AB734

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.53 - (show annotations)
Thu Aug 1 04:03:13 2002 UTC (11 years, 8 months ago) by kaz
Branch: MAIN
CVS Tags: symlink-branch~branch-point, mcvs-0-22, mcvs-0-23, mcvs-0-21, symlink-branch~merged-to-HEAD-0
Branch point for: symlink-branch
Changes since 1.52: +1 -1 lines
* code/grab.lisp (correlate-word-hashes): The rule for computing
the correlation changes. The size of the smaller of the two sets
is used as the denominator, rather than the size of the union.
This produces far better results for files that have grown
or shrunk a lot; files are not penalized for growing.

More changes to syntax of grab command. Now -A must be
specified to do a grab onto main trunk.

* code/mcvs-main.lisp (*grab-options*): -A option added.

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

  ViewVC Help
Powered by ViewVC 1.1.5