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

Contents of /meta-cvs/F-AFC09F145399B1273F4BF98702F5BE8C

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.23 - (show annotations)
Sat Jun 29 14:15:25 2002 UTC (11 years, 9 months ago) by kaz
Branch: MAIN
Changes since 1.22: +27 -17 lines
* options.lisp (*nometa-option*): Eliminated rid useless docstring.
(*meta-option*): New variable.
(*nometa-option*): New variable.
(filter-global-options): Clean rewrite using find-bind.

* generic.lisp (mcvs-generic): New keyword parameters
default-include-meta-files, need-update-after. Implements new logic
related to the new options. Performs (mapping-update) if
need-update-after is true and metafiles were subject to cvs update.
(mcvs-commit-wrapper): Calls mcvs-generic with
:default-include-meta-files t.

* update.lisp (mcvs-update): No longer overrides the *nometa-option*
special variable. Passes :need-update-after t to mcvs-generic.

* mcvs-main.lisp (*cvs-options*): New options entered into list.
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
13 files &key need-sync-after default-include-meta-files
14 need-update-after)
15 (in-sandbox-root-dir
16 (let (files-to-process
17 (filemap (mapping-read *mcvs-map-local*))
18 (do-meta-files (and (or *metaonly-option* *meta-option*
19 default-include-meta-files)
20 (not *nometa-option*))))
21
22 (unless *metaonly-option*
23 (chatter-debug "Preparing file list.~%")
24
25 (if (null files)
26 (setf files-to-process
27 (mapping-prefix-matches filemap
28 (sandbox-translate-path ".")))
29 (dolist (file files)
30 (can-restart-here ("Continue preparing file list.")
31 (let* ((full-name (sandbox-translate-path file))
32 (entries (mapping-prefix-matches filemap full-name)))
33 (if (not entries)
34 (error "mcvs: ~a is not known to Meta-CVS." full-name)
35 (setf files-to-process (nconc files-to-process entries))))))))
36
37 (unless (and (not files-to-process)
38 (not do-meta-files))
39 (chatter-debug "Synchronizing.~%")
40 (mapping-synchronize)
41
42 (current-dir-restore
43 (chdir *mcvs-dir*)
44 (chatter-debug "Invoking CVS.~%")
45 (execute-program-xargs `("cvs" ,@(format-opt cvs-options)
46 ,cvs-command ,@(format-opt command-options)
47 ,@command-args)
48 `(,@(when do-meta-files
49 (let (metas)
50 (when (exists ".cvsignore")
51 (push ".cvsignore" metas))
52 (when (exists *mcvs-types-name*)
53 (push *mcvs-types-name* metas))
54 (cons *mcvs-map-name* metas)))
55 ,@(mapcar #'(lambda (x)
56 (basename (first x)))
57 files-to-process))))
58 (when (and do-meta-files need-update-after)
59 (chatter-debug "Updating file structure.~%")
60 (mapping-update))
61 (when need-sync-after
62 (chatter-debug "Synchronizing again.~%")
63 (mapping-synchronize))))
64 (values)))
65
66 (defun mcvs-commit-wrapper (cvs-options cvs-command-options mcvs-args)
67 (mcvs-generic "commit" cvs-options cvs-command-options nil mcvs-args
68 :default-include-meta-files t))
69
70 (defun mcvs-diff-wrapper (cvs-options cvs-command-options mcvs-args)
71 (mcvs-generic "diff" cvs-options cvs-command-options nil mcvs-args))
72
73 (defun mcvs-tag-wrapper (cvs-options cvs-command-options mcvs-args)
74 (if (null mcvs-args)
75 (error "mcvs-tag: specify tag optionally followed by files."))
76 (mcvs-generic "tag" cvs-options
77 cvs-command-options (list (first mcvs-args)) (rest mcvs-args)))
78
79 (defun mcvs-log-wrapper (cvs-options cvs-command-options mcvs-args)
80 (mcvs-generic "log" cvs-options cvs-command-options nil mcvs-args))
81
82 (defun mcvs-status-wrapper (cvs-options cvs-command-options mcvs-args)
83 (mcvs-generic "status" cvs-options cvs-command-options nil mcvs-args))
84
85 (defun mcvs-annotate-wrapper (cvs-options cvs-command-options mcvs-args)
86 (mcvs-generic "annotate" cvs-options cvs-command-options nil mcvs-args))

  ViewVC Help
Powered by ViewVC 1.1.5