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

Contents of /meta-cvs/F-233AD6EEE14894A7303F09519A2AB734

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.94 - (show annotations)
Mon Mar 8 06:11:40 2004 UTC (10 years, 1 month ago) by kaz
Branch: MAIN
CVS Tags: mcvs-1-1-0
Changes since 1.93: +0 -28 lines
Revamped loading system. Got rid of require/provide in all
Lisp source files.

* code/mcvs.lisp: New file. Responsible for compiling and loading
everything in the right order.

* code/mcvs-main.lisp: File renamed to main.lisp.

* code/mcvs-package.lisp: File renamed to package.lisp.

* code/system.lisp: File removed.
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 (in-package "META-CVS")
6
7 (define-option-constant *global-options*
8 (0 arg "H" "help" "Q" "q" "r" "w" "l" "n" "t" "v" "f" "version"
9 "meta" "metaonly" "nometa" "error-continue" "error-terminate" "debug")
10 (1 arg "T" "e" "d" "r" "z" "s" "i" "up"))
11
12 (define-option-constant *help-options*)
13
14 (define-option-constant *create-options*
15 (0 arg "d")
16 (1 arg "k" "I" "b" "m" "W"))
17
18 (define-option-constant *grab-options*
19 (0 arg "A")
20 (1 arg "r"))
21
22 (define-option-constant *checkout-options*
23 (0 arg "f")
24 (1 arg "r" "D" "d" "k" "j"))
25
26 (define-option-constant *export-options*
27 (0 arg "f")
28 (1 arg "r" "D" "d" "k"))
29
30 (define-option-constant *add-options*
31 (0 arg "R")
32 (1 arg "k" "m"))
33
34 (define-option-constant *remove-options*
35 (0 arg "R"))
36
37 (define-option-constant *update-options*
38 (0 arg "A" "C" "f" "p")
39 (1 arg "k" "r" "D" "j" "I" "W"))
40
41 (define-option-constant *switch-options*
42 (1 arg "k" "I" "W"))
43
44 (define-option-constant *commit-options*
45 (0 arg "f")
46 (1 arg "F" "m" "r"))
47
48 (define-option-constant *diff-options*
49 (0 arg "a" "b" "B" "brief" "c" "d" "e" "ed" "expand-tabs" "f" "forward-ed"
50 "H" "i" "ignore-all-space" "ignore-blank-lines" "ignore-case"
51 "ignore-space-change" "initial-tab" "l" "left-column" "minimal" "n"
52 "N" "new-file" "p" "P" "--paginate" "q" "rcs" "report-identical-files"
53 "s" "show-c-function" "side-by-side" "speed-large-files"
54 "suppress-common-lines" "t" "T" "text" "u" "unidirectional-new-file"
55 "w" "y")
56 (1 arg "C" "context" "D" "F" "horizon-lines" "ifdef" "ignore-matching-lines"
57 "L" "label" "line-format" "new-group-format" "new-line-format"
58 "old-group-format" "old-line-format" "r" "show-function-line"
59 "unchanged-group-format" "unchanged-line-format" "U" "unified" "W"
60 "width"))
61
62 (define-option-constant *tag-options*
63 (0 arg "l" "d" "f" "b" "F" "c")
64 (1 arg "r" "D"))
65
66 (define-option-constant *log-options*
67 (0 arg "R" "h" "t" "N" "b")
68 (1 arg "r" "d" "s" "w"))
69
70 (define-option-constant *status-options*
71 (0 arg "v"))
72
73 (define-option-constant *annotate-options*
74 (0 arg "f")
75 (1 arg "r" "D"))
76
77 (define-option-constant *filt-options*
78 (1 arg "r" "D"))
79
80 (define-option-constant *remote-filt-options*
81 (1 arg "r" "D"))
82
83 (define-option-constant *move-options*)
84 (define-option-constant *link-options*)
85 (define-option-constant *convert-options*)
86 (define-option-constant *branch-options*)
87
88 (define-option-constant *merge-options*
89 (1 arg "k"))
90
91 (define-option-constant *remerge-options*
92 (1 arg "k"))
93
94 (define-option-constant *list-branches-options*)
95 (define-option-constant *remap-options*)
96 (define-option-constant *purge-options*)
97 (define-option-constant *restore-options*)
98
99 (define-option-constant *prop-options*
100 (1 arg "set" "clear" "remove")
101 (2 arg "value"))
102
103 (define-option-constant *watch-options*
104 (0 arg "on" "off")
105 (1 arg "add" "remove"))
106
107 (define-option-constant *watchers-options*)
108 (define-option-constant *edit-options*)
109 (define-option-constant *unedit-options*)
110 (define-option-constant *editors-options*)
111 (define-option-constant *sync-to-cvs-options*)
112 (define-option-constant *sync-from-cvs-options*)
113
114 (declaim (special *usage* *mcvs-command-table*))
115
116 (defun mcvs-help (global-options command-options args)
117 (declare (ignore global-options command-options))
118 (cond
119 ((null args)
120 (terpri)
121 (write-line *usage*)
122 (terpri))
123 ((= (length args) 1)
124 (let* ((command-name (first args))
125 (command (find command-name *mcvs-command-table*
126 :key #'first
127 :test #'string=)))
128 (when (null command)
129 (error "~a is not a recognized mcvs command."
130 command-name))
131 (let ((help-text (third command)))
132 (when (null help-text)
133 (error "sorry, no help available for ~a command."
134 command-name))
135 (terpri)
136 (write-line help-text)
137 (terpri))))
138 (t (error "try \"mcvs help <name-of-command>\"."))))
139
140 (defconstant *mcvs-command-table*
141 `(("help" ,#'mcvs-help nil ,*help-options*)
142 ("create" ,#'mcvs-create-wrapper ,*create-help* ,*create-options*)
143 ("grab" ,#'mcvs-grab-wrapper ,*grab-help* ,*grab-options*)
144 ("checkout" ,#'mcvs-checkout-wrapper ,*checkout-help* ,*checkout-options*)
145 ("co" ,#'mcvs-checkout-wrapper ,*checkout-help* ,*checkout-options*)
146 ("export" ,#'mcvs-export-wrapper ,*export-help* ,*export-options*)
147 ("ex" ,#'mcvs-export-wrapper ,*export-help* ,*export-options*)
148 ("add" ,#'mcvs-add-wrapper ,*add-help* ,*add-options*)
149 ("remove" ,#'mcvs-remove-wrapper ,*remove-help* ,*remove-options*)
150 ("rm" ,#'mcvs-remove-wrapper ,*remove-help* ,*remove-options*)
151 ("move" ,#'mcvs-move-wrapper ,*move-help* ,*move-options*)
152 ("mv" ,#'mcvs-move-wrapper ,*move-help* ,*move-options*)
153 ("link" ,#'mcvs-link-wrapper ,*link-help* ,*link-options*)
154 ("ln" ,#'mcvs-link-wrapper ,*link-help* ,*link-options*)
155 ("update" ,#'mcvs-update-wrapper nil ,*update-options*)
156 ("up" ,#'mcvs-update-wrapper nil ,*update-options*)
157 ("commit" ,#'mcvs-commit-wrapper nil ,*commit-options*)
158 ("ci" ,#'mcvs-commit-wrapper nil ,*commit-options*)
159 ("diff" ,#'mcvs-diff-wrapper nil ,*diff-options*)
160 ("tag" ,#'mcvs-tag-wrapper nil ,*tag-options*)
161 ("log" ,#'mcvs-log-wrapper nil ,*log-options*)
162 ("status" ,#'mcvs-status-wrapper nil ,*status-options*)
163 ("stat" ,#'mcvs-status-wrapper nil ,*status-options*)
164 ("annotate" ,#'mcvs-annotate-wrapper nil ,*annotate-options*)
165 ("filt" ,#'mcvs-filt-wrapper nil ,*filt-options*)
166 ("fi" ,#'mcvs-filt-wrapper nil ,*filt-options*)
167 ("remote-filt" ,#'mcvs-remote-filt-wrapper nil ,*remote-filt-options*)
168 ("rfilt" ,#'mcvs-remote-filt-wrapper nil ,*remote-filt-options*)
169 ("rfi" ,#'mcvs-remote-filt-wrapper nil ,*remote-filt-options*)
170 ("convert" ,#'mcvs-convert-wrapper ,*convert-help* ,*convert-options*)
171 ("branch" ,#'mcvs-branch-wrapper ,*branch-help* ,*branch-options*)
172 ("switch" ,#'mcvs-switch-wrapper nil ,*switch-options*)
173 ("sw" ,#'mcvs-switch-wrapper nil ,*switch-options*)
174 ("merge" ,#'mcvs-merge-wrapper nil ,*merge-options*)
175 ("remerge" ,#'mcvs-remerge-wrapper nil ,*remerge-options*)
176 ("list-branches" ,#'mcvs-list-branches-wrapper nil ,*list-branches-options*)
177 ("lb" ,#'mcvs-list-branches-wrapper nil ,*list-branches-options*)
178 ("purge" ,#'mcvs-purge-wrapper nil ,*purge-options*)
179 ("restore" ,#'mcvs-restore-wrapper nil ,*restore-options*)
180 ("remap" ,#'mcvs-remap-wrapper nil ,*remap-options*)
181 ("prop" ,#'mcvs-prop-wrapper nil ,*prop-options*)
182 ("watch" ,#'mcvs-watch-wrapper nil ,*watch-options*)
183 ("watchers" ,#'mcvs-watchers-wrapper nil ,*watchers-options*)
184 ("edit" ,#'mcvs-edit-wrapper nil ,*edit-options*)
185 ("unedit" ,#'mcvs-unedit-wrapper nil ,*unedit-options*)
186 ("editors" ,#'mcvs-editors-wrapper nil ,*editors-options*)
187 ("sync-from-cvs" ,#'mcvs-sync-from-wrapper nil ,*editors-options*)
188 ("sync-to-cvs" ,#'mcvs-sync-to-wrapper nil ,*editors-options*)))
189
190 (defconstant *usage*
191 "Meta-CVS command syntax:
192
193 mcvs [ global-options ] command [ command-options ] [ command-arguments ]
194
195 Global options:
196
197 -H --help Print this help and terminate. If a command is specified,
198 help specific to that command is printed instead.
199 -Q Very quiet, generate output only for serious problems. (*)
200 -q Somewhat quiet, some info messages suppressed. (*)
201 -n Dry run; do not modify filesystem. (*)
202 --debug Verbose debug output; -Q and -q are ignored but still
203 passed to CVS.
204 -r Make working files read-only. (@)
205 -w Make new working files read-write (default). (@)
206 -l Do not log cvs command in command history, but execute
207 it anyway. (@)
208 -t Trace CVS execution. (@)
209 -v --version Display version information and terminate.
210 -f CVS not to read ~/.cvsrc file. (@)
211 -i script-name Load a Lisp file and evaluate its top level forms,
212 allowing Meta-CVS to behave as an interpreter.
213 --meta Include metafiles such as MCVS/MAP in the set of files
214 to operate on.
215 --metaonly Operate only on metafiles.
216 --nometa Exclude metafiles from the set of files to operate on.
217 --error-continue Instead of interactive error handling, automatically
218 continue all continuable errors.
219 --error-terminate Terminate with cleanup when an error happens instead
220 of interactive error handling.
221 -T tempdir Place temporary files in tempdir. (@)
222 -e editor Edit messages with editor. (*)
223 -d root Specify CVSROOT. (@)
224 -z gzip-level Specify compression level. (@)
225 --up N Escape out of N levels of sandbox nesting before executing
226 operation.
227
228 Notes: (*) option processed by Meta-CVS and passed to CVS too.
229 (@) option merely passed to CVS.
230
231 Commands:
232
233 help Obtain more detailed help for a specific command.
234 create Create new project from an existing file tree.
235 grab Take a snapshot of an external source tree, such
236 as a third-party release, and incorporate it into
237 the working copy. Tries to discover file moves.
238 checkout (co) Retrieve a Meta-CVS project from the repository to
239 create a working copy.
240 export (ex) Retrieve a Meta-CVS project without creating a
241 working copy.
242 add Place files (or directories with add -R) under
243 version control.
244 remove (rm) Remove files or directories.
245 move (mv) Rename files and directories.
246 link (ln) Create a versioned symbolic link.
247 update (up) Incorporate latest changes from repository into
248 working copy.
249 commit (ci) Incorporate outstanding changes in the working copy
250 into the repository.
251 diff Compute differences between files in the working copy
252 and the repository or between revisions in the repository.
253 tag Associate a symbolic name with file revisions to create
254 an identifiable baseline. By default, tags the
255 revisions that were last synchronized with the
256 directory. Note: tag -b creates a CVS branch,
257 it won't be a Meta-CVS branch with managed merges.
258 Consider the branch command instead!
259 log Display log information for files.
260 status (stat) Show current status of files.
261 annotate Perform a detailed analysis of files, showing the
262 version information about every individual line of text.
263 filt (fi) Act as a text filter, which converts Meta-CVS F- file
264 names to readable paths, according to the current mapping.
265 remote-filt (rfi) Remote version of filt, requires module name.
266 branch Create a managed branch. Meta-CVS managed branches keep
267 track of what has been merged where, so users don't have
268 to track merges with tags at all.
269 merge Merge a managed branch to the current branch or trunk.
270 remerge Re-apply the most recent merge without changing any tags.
271 Useful when a merge goes bad so the local changes have
272 to be discarded and the merge done over again.
273 list-branches (lb) List Meta-CVS managed branches.
274 switch (sw) Switch to a branch. With no arguments, switch to
275 main trunk.
276 remap Force Meta-CVS to notice and incorporate moves and
277 deletions that were performed directly on the sandbox.
278 purge Execute a CVS remove on files that have been unmapped
279 with the remove command.
280 restore Restore files that have been deleted with the remove
281 command, but not purged. These appear in the lost+found
282 directory under cryptic names.
283 prop Manipulate properties.
284 prop --set <bool-prop-name> [ files ... ]
285 prop --clear <bool-prop-name> [ files ... ]
286 prop --value <prop-name> <new-value> [ files ... ]
287 prop --remove <prop-name> [ files ... ]
288 The ``exec'' property represents the execute permission
289 of a file. More than one --set, --clear, --value
290 or --remove may be specified before the files.
291 watch Manipulate per-file CVS watch settings.
292 watch --on [ files ... ]
293 watch --off [ files ... ]
294 watch --add <action> [ files ... ]
295 watch --remove <action> [ files ... ]
296 watchers See who is watching files.
297 edit Indicate the intent to edit a watched file.
298 unedit Retract the indication signaled by edit.
299 editors See who is editing files.
300 sync-to-cvs Synchronize tree in the direction of the CVS sandbox.
301 Useful when extending Meta-CVS with external scripts.
302 sync-from-cvs Synchronize CVS sandbox to the tree.
303 convert Convert a CVS module to a Meta-CVS project.
304 This requires direct filesystem access to the repository.
305 Caveat: this is a very blunt instrument.")
306
307 (defmacro with-open-file-ignore-errors ((var &rest open-args) &body forms)
308 `(let ((,var (ignore-errors (open ,@open-args))))
309 (unwind-protect
310 (progn ,@forms)
311 (when ,var (close ,var)))))
312
313 (defun mcvs-execute (args)
314 (with-open-file-ignore-errors (*interactive-error-io* (parse-posix-namestring
315 (unix-funcs:ctermid))
316 :direction :io
317 :if-does-not-exist nil)
318 (let ((*mcvs-error-treatment* (if *interactive-error-io*
319 :interactive
320 :terminate)))
321 (unless *interactive-error-io*
322 (chatter-info "unable to open terminal device ~a .~%"
323 (unix-funcs:ctermid))
324 (chatter-info "interactive error handling disabled.~%"))
325 (handler-bind ((error #'mcvs-error-handler))
326 (multiple-value-bind (global-options global-args)
327 (parse-opt args *global-options*)
328 (setf global-options (filter-global-options global-options))
329
330 (when *print-usage*
331 (terpri)
332 (write-line *usage*)
333 (terpri)
334 (throw 'mcvs-terminate nil))
335
336 (when (not (first global-args))
337 (write-line "Meta-CVS requires a command argument." *error-output*)
338 (write-line "Use mcvs -H to view help." *error-output*)
339 (throw 'mcvs-terminate nil))
340
341 (let ((command (find (first global-args) *mcvs-command-table*
342 :key #'first
343 :test #'string=)))
344 (when (not command)
345 (error "~a is not a recognized mcvs command."
346 (first global-args)))
347 (destructuring-bind (name func help-text opt-spec) command
348 (declare (ignore name help-text))
349 (multiple-value-bind (command-options command-args)
350 (parse-opt (rest global-args) opt-spec)
351 (funcall func global-options command-options command-args)))))))
352 nil))
353
354 (defun mcvs-debug-shell ()
355 (let ((counter 0)
356 (*mcvs-error-treatment* :decline))
357 (loop
358 (format t "~&mcvs[~a]> " (incf counter))
359 (let ((line (string-trim #(#\space #\tab) (read-line))))
360 (restart-case
361 (cond
362 ((zerop (length line)))
363 ((string-equal line "exit")
364 (return-from mcvs-debug-shell))
365 ((char-equal (char line 0) #\!)
366 (print (eval (read-from-string (subseq line 1)))))
367 (t (mcvs-execute (split-words line #(#\space #\tab)))))
368 (debug () :report "Return to mcvs debug shell"
369 (terpri)))))))
370
371 #+clisp
372 (defun main ()
373 (ext:exit (catch 'mcvs-terminate (or (mcvs-execute ext:*args*)
374 *mcvs-errors-occured-p*))))

  ViewVC Help
Powered by ViewVC 1.1.5