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

Contents of /meta-cvs/F-AFC09F145399B1273F4BF98702F5BE8C

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.15 - (show annotations)
Mon Feb 4 06:40:51 2002 UTC (12 years, 2 months ago) by kaz
Branch: MAIN
CVS Tags: mcvs-0-6, mcvs-0-5, mcvs-0-4, latest-patch
Changes since 1.14: +1 -1 lines
Oops, broken tag command.
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 "chatter")
8 (require "options")
9 (provide "generic")
10
11 (defun mcvs-generic (cvs-command cvs-options command-options command-args files)
12 (in-sandbox-root-dir
13 (let (files-to-process
14 (filemap (mapping-read *mcvs-map-local*)))
15
16 (chatter-info "Preparing file list.~%")
17 (when (null files)
18 (setf files '(".")))
19 (dolist (file files)
20 (can-restart-here ("Continue preparing file list.")
21 (let* ((full-name (sandbox-translate-path file))
22 (entries (mapping-prefix-matches filemap full-name)))
23 (if (not entries)
24 (error "mcvs: ~a is not known to Meta-CVS." full-name)
25 (setf files-to-process (nconc files-to-process entries))))))
26
27 (when files-to-process
28 (chatter-info "Synchronizing.~%")
29 (mapping-synchronize)
30
31 (current-dir-restore
32 (chdir *mcvs-dir*)
33 (chatter-info "Invoking CVS.~%")
34 (execute-program-xargs `("cvs" ,@(format-opt cvs-options)
35 ,cvs-command ,@(format-opt command-options)
36 ,@command-args)
37 `("MAP"
38 ,@(mapcar #'(lambda (x)
39 (basename (first x)))
40 files-to-process))))))
41 (values)))
42
43 (defun mcvs-diff-wrapper (cvs-options cvs-command-options mcvs-args)
44 (mcvs-generic "diff" cvs-options cvs-command-options nil mcvs-args))
45
46 (defun mcvs-tag-wrapper (cvs-options cvs-command-options mcvs-args)
47 (if (null mcvs-args)
48 (error "mcvs-tag: specify tag optionally followed by files."))
49 (mcvs-generic "tag" cvs-options
50 cvs-command-options (list (first mcvs-args)) (rest mcvs-args)))
51
52 (defun mcvs-log-wrapper (cvs-options cvs-command-options mcvs-args)
53 (mcvs-generic "log" cvs-options cvs-command-options nil mcvs-args))
54
55 (defun mcvs-status-wrapper (cvs-options cvs-command-options mcvs-args)
56 (mcvs-generic "status" cvs-options cvs-command-options nil mcvs-args))
57
58 (defun mcvs-annotate-wrapper (cvs-options cvs-command-options mcvs-args)
59 (mcvs-generic "annotate" cvs-options cvs-command-options nil mcvs-args))

  ViewVC Help
Powered by ViewVC 1.1.5