/[meta-cvs]/meta-cvs/F-AFC09F145399B1273F4BF98702F5BE8C
ViewVC logotype

Contents of /meta-cvs/F-AFC09F145399B1273F4BF98702F5BE8C

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.18 - (show annotations)
Sun Mar 10 03:32:47 2002 UTC (12 years, 1 month ago) by kaz
Branch: MAIN
CVS Tags: mcvs-0-7
Changes since 1.17: +6 -1 lines
Commit is handled through mcvs-generic, so it can take
filename arguments, and honor --nometa.

* commit.lisp: File removed.
(mcvs-commit): Function removed.
(mcvs-commit-wrapper): Moved to generic.lisp.

* generic.lisp (mcvs-commit-wrapper): Moved from commit.lisp,
changed to invoke mcvs-generic.
(mcvs-generic): Only add TYPES file to list if it actually
exists.
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 "system")
6 (require "mapping")
7 (require "types")
8 (require "chatter")
9 (require "options")
10 (provide "generic")
11
12 (defun mcvs-generic (cvs-command cvs-options command-options command-args files)
13 (in-sandbox-root-dir
14 (let (files-to-process
15 (filemap (mapping-read *mcvs-map-local*)))
16
17 (chatter-info "Preparing file list.~%")
18 (when (null files)
19 (setf files '(".")))
20 (dolist (file files)
21 (can-restart-here ("Continue preparing file list.")
22 (let* ((full-name (sandbox-translate-path file))
23 (entries (mapping-prefix-matches filemap full-name)))
24 (if (not entries)
25 (error "mcvs: ~a is not known to Meta-CVS." full-name)
26 (setf files-to-process (nconc files-to-process entries))))))
27
28 (when files-to-process
29 (chatter-info "Synchronizing.~%")
30 (mapping-synchronize)
31
32 (current-dir-restore
33 (chdir *mcvs-dir*)
34 (chatter-info "Invoking CVS.~%")
35 (execute-program-xargs `("cvs" ,@(format-opt cvs-options)
36 ,cvs-command ,@(format-opt command-options)
37 ,@command-args)
38 `(,@(unless *nometa-option*
39 (if (exists *mcvs-types-name*)
40 (list *mcvs-map-name* *mcvs-types-name*)
41 (list *mcvs-map-name*)))
42 ,@(mapcar #'(lambda (x)
43 (basename (first x)))
44 files-to-process))))))
45 (values)))
46
47 (defun mcvs-commit-wrapper (cvs-options cvs-command-options mcvs-args)
48 (mcvs-generic "commit" cvs-options cvs-command-options nil mcvs-args))
49
50 (defun mcvs-diff-wrapper (cvs-options cvs-command-options mcvs-args)
51 (mcvs-generic "diff" cvs-options cvs-command-options nil mcvs-args))
52
53 (defun mcvs-tag-wrapper (cvs-options cvs-command-options mcvs-args)
54 (if (null mcvs-args)
55 (error "mcvs-tag: specify tag optionally followed by files."))
56 (mcvs-generic "tag" cvs-options
57 cvs-command-options (list (first mcvs-args)) (rest mcvs-args)))
58
59 (defun mcvs-log-wrapper (cvs-options cvs-command-options mcvs-args)
60 (mcvs-generic "log" cvs-options cvs-command-options nil mcvs-args))
61
62 (defun mcvs-status-wrapper (cvs-options cvs-command-options mcvs-args)
63 (mcvs-generic "status" cvs-options cvs-command-options nil mcvs-args))
64
65 (defun mcvs-annotate-wrapper (cvs-options cvs-command-options mcvs-args)
66 (mcvs-generic "annotate" cvs-options cvs-command-options nil mcvs-args))

  ViewVC Help
Powered by ViewVC 1.1.5