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

Contents of /meta-cvs/F-233AD6EEE14894A7303F09519A2AB734

Parent Directory Parent Directory | Revision Log Revision Log


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

  ViewVC Help
Powered by ViewVC 1.1.5