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

Contents of /meta-cvs/F-AFC09F145399B1273F4BF98702F5BE8C

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.21 - (hide annotations)
Thu Mar 14 19:03:35 2002 UTC (12 years, 1 month ago) by kaz
Branch: MAIN
CVS Tags: mcvs-0-9, mcvs-0-11, mcvs-0-10, deferred-adds-branch~branch-point
Branch point for: deferred-adds-branch
Changes since 1.20: +6 -2 lines
Update takes file arguments now.

* update.lisp (mcvs-update): If filename arguments are given, then
just call mcvs-generic to do the work, but suppress the operation on
meta files. If no filename arguments are given, then update everything.
If the -p option is present, no synchronization is needed, before or
after.
(mcvs-update-wrapper): Pass command arguments down to mcvs-update.

* mcvs-main.lisp (*update-options*): Add "p" option.

* generic.lisp (mcvs-generic): New keyword parameter need-sync-after,
a generalized boolean which can tell the function to do a
mapping-synchronize after executing the CVS command.
1 kaz 1.9 ;;; This source file is part of the Meta-CVS program,
2 kaz 1.6 ;;; which is distributed under the GNU license.
3     ;;; Copyright 2002 Kaz Kylheku
4    
5 kaz 1.1 (require "system")
6     (require "mapping")
7 kaz 1.17 (require "types")
8 kaz 1.1 (require "chatter")
9 kaz 1.7 (require "options")
10 kaz 1.13 (provide "generic")
11 kaz 1.1
12 kaz 1.21 (defun mcvs-generic (cvs-command cvs-options command-options command-args
13     files &key need-sync-after)
14 kaz 1.3 (in-sandbox-root-dir
15 kaz 1.13 (let (files-to-process
16 kaz 1.10 (filemap (mapping-read *mcvs-map-local*)))
17 kaz 1.1
18 kaz 1.19 (chatter-debug "Preparing file list.~%")
19 kaz 1.1 (when (null files)
20     (setf files '(".")))
21     (dolist (file files)
22 kaz 1.13 (can-restart-here ("Continue preparing file list.")
23 kaz 1.3 (let* ((full-name (sandbox-translate-path file))
24 kaz 1.11 (entries (mapping-prefix-matches filemap full-name)))
25 kaz 1.3 (if (not entries)
26 kaz 1.13 (error "mcvs: ~a is not known to Meta-CVS." full-name)
27     (setf files-to-process (nconc files-to-process entries))))))
28 kaz 1.1
29 kaz 1.13 (when files-to-process
30 kaz 1.19 (chatter-debug "Synchronizing.~%")
31 kaz 1.1 (mapping-synchronize)
32    
33     (current-dir-restore
34     (chdir *mcvs-dir*)
35 kaz 1.19 (chatter-debug "Invoking CVS.~%")
36 kaz 1.12 (execute-program-xargs `("cvs" ,@(format-opt cvs-options)
37 kaz 1.13 ,cvs-command ,@(format-opt command-options)
38     ,@command-args)
39 kaz 1.17 `(,@(unless *nometa-option*
40 kaz 1.20 (let (metas)
41     (when (exists ".cvsignore")
42     (push ".cvsignore" metas))
43     (when (exists *mcvs-types-name*)
44     (push *mcvs-types-name* metas))
45     (cons *mcvs-map-name* metas)))
46 kaz 1.12 ,@(mapcar #'(lambda (x)
47     (basename (first x)))
48 kaz 1.21 files-to-process))))
49     (when need-sync-after
50     (chatter-debug "Synchronizing again.~%")
51     (mapping-synchronize))))
52 kaz 1.1 (values)))
53 kaz 1.18
54     (defun mcvs-commit-wrapper (cvs-options cvs-command-options mcvs-args)
55     (mcvs-generic "commit" cvs-options cvs-command-options nil mcvs-args))
56 kaz 1.4
57 kaz 1.7 (defun mcvs-diff-wrapper (cvs-options cvs-command-options mcvs-args)
58 kaz 1.13 (mcvs-generic "diff" cvs-options cvs-command-options nil mcvs-args))
59    
60     (defun mcvs-tag-wrapper (cvs-options cvs-command-options mcvs-args)
61     (if (null mcvs-args)
62     (error "mcvs-tag: specify tag optionally followed by files."))
63     (mcvs-generic "tag" cvs-options
64 kaz 1.15 cvs-command-options (list (first mcvs-args)) (rest mcvs-args)))
65 kaz 1.14
66     (defun mcvs-log-wrapper (cvs-options cvs-command-options mcvs-args)
67     (mcvs-generic "log" cvs-options cvs-command-options nil mcvs-args))
68    
69     (defun mcvs-status-wrapper (cvs-options cvs-command-options mcvs-args)
70     (mcvs-generic "status" cvs-options cvs-command-options nil mcvs-args))
71    
72     (defun mcvs-annotate-wrapper (cvs-options cvs-command-options mcvs-args)
73     (mcvs-generic "annotate" cvs-options cvs-command-options nil mcvs-args))

  ViewVC Help
Powered by ViewVC 1.1.5