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

Contents of /meta-cvs/F-AFC09F145399B1273F4BF98702F5BE8C

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.29.2.7 - (show annotations)
Wed Jul 16 15:44:11 2003 UTC (10 years, 9 months ago) by kaz
Branch: mcvs-1-0-branch
CVS Tags: mcvs-1-0-branch~merged-to-HEAD-1, mcvs-1-0-branch~merged-to-HEAD-0, mcvs-1-0-11, mcvs-1-0-10, mcvs-1-0-13, mcvs-1-0-12, mcvs-1-0-9
Changes since 1.29.2.6: +31 -25 lines
* code/mcvs-generic.lisp (mcvs-generic): Removed
the default-include-meta-files keyword parameter.
(mcvs-tag, mcvs-commit): Remove use of keyword parameter.
This fixes the silly behavior of including meta files
even when the command line specifies a file list.
Also, bugfix: *nometa-option* now works when
global-if-empty-file-list is true, and there are no files.

* code/update.lisp (mcvs-update): Remove use of keyword
parameter in call to mcvs-generic.
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-before need-sync-after
14 need-update-after global-if-empty-file-list
15 no-invoke-cvs)
16 (when (and *metaonly-option* files)
17 (error "cannot specify both --metaonly option and file arguments."))
18 (in-sandbox-root-dir
19 (let (files-to-process
20 (filemap (mapping-read *mcvs-map-local*))
21 (do-meta-files (and (or *metaonly-option* *meta-option*)
22 (not *nometa-option*)
23 (or files
24 (not global-if-empty-file-list)
25 *metaonly-option*))))
26
27 (unless *metaonly-option*
28 (chatter-debug "Preparing file list.~%")
29
30 (cond
31 ((and (null files)
32 global-if-empty-file-list
33 *nometa-option*)
34 (setf files-to-process filemap))
35 ((and (null files)
36 (not global-if-empty-file-list))
37 (setf files-to-process
38 (mapping-prefix-matches filemap
39 (sandbox-translate-path "."))))
40 (files
41 (dolist (file files)
42 (can-restart-here ("Continue preparing file list.")
43 (let* ((full-name (sandbox-translate-path file))
44 (abs-name (canonicalize-path
45 (real-to-abstract-path full-name)))
46 (entries (mapping-prefix-matches filemap abs-name)))
47 (if (not entries)
48 (error "~a is not known to Meta-CVS." full-name)
49 (setf files-to-process (nconc files-to-process
50 entries)))))))))
51
52 (setf files-to-process (mapping-extract-kind files-to-process :file))
53
54 (when (or files-to-process
55 do-meta-files
56 global-if-empty-file-list)
57 (when need-sync-before
58 (chatter-debug "Synchronizing.~%")
59 (mapping-synchronize :filemap files-to-process
60 :direction :left))
61 (unless no-invoke-cvs
62 (current-dir-restore
63 (chdir *mcvs-dir*)
64 (chatter-debug "Invoking CVS.~%")
65 (execute-program-xargs `("cvs" ,@(format-opt cvs-options)
66 ,cvs-command ,@(format-opt command-options)
67 ,@command-args)
68 `(,@(when do-meta-files
69 (let (metas)
70 (when (exists ".cvsignore")
71 (push ".cvsignore" metas))
72 (when (exists *mcvs-types-name*)
73 (push *mcvs-types-name* metas))
74 (cons *mcvs-map-name* metas)))
75 ,@(mapcar #'(lambda (x)
76 (basename
77 (mapping-entry-id x)))
78 files-to-process)))))
79 (when (and do-meta-files need-update-after)
80 (chatter-debug "Updating file structure.~%")
81 (mapping-update))
82 (when need-sync-after
83 (chatter-debug "Synchronizing again.~%")
84 (mapping-synchronize :filemap files-to-process
85 :direction :right))))
86 (values)))
87
88 (defun mcvs-commit-wrapper (cvs-options cvs-command-options mcvs-args)
89 (mcvs-generic "commit" cvs-options cvs-command-options nil mcvs-args
90 :need-sync-before t
91 :need-sync-after t
92 :global-if-empty-file-list t))
93
94 (defun mcvs-diff-wrapper (cvs-options cvs-command-options mcvs-args)
95 (mcvs-generic "diff" cvs-options cvs-command-options nil mcvs-args
96 :need-sync-before t))
97
98 (defun mcvs-tag-wrapper (cvs-options cvs-command-options mcvs-args)
99 (if (null mcvs-args)
100 (error "specify tag optionally followed by files."))
101 (mcvs-generic "tag" cvs-options
102 cvs-command-options (list (first mcvs-args)) (rest mcvs-args)
103 :global-if-empty-file-list t))
104
105 (defun mcvs-log-wrapper (cvs-options cvs-command-options mcvs-args)
106 (mcvs-generic "log" cvs-options cvs-command-options nil mcvs-args))
107
108 (defun mcvs-status-wrapper (cvs-options cvs-command-options mcvs-args)
109 (mcvs-generic "status" cvs-options cvs-command-options nil mcvs-args
110 :need-sync-before t))
111
112 (defun mcvs-annotate-wrapper (cvs-options cvs-command-options mcvs-args)
113 (mcvs-generic "annotate" cvs-options cvs-command-options nil mcvs-args))
114
115 (defun mcvs-watchers-wrapper (cvs-options cvs-command-options mcvs-args)
116 (mcvs-generic "watchers" cvs-options cvs-command-options nil mcvs-args))
117
118 (defun mcvs-edit-wrapper (cvs-options cvs-command-options mcvs-args)
119 (mcvs-generic "edit" cvs-options cvs-command-options nil mcvs-args
120 :need-sync-before t))
121
122 (defun mcvs-unedit-wrapper (cvs-options cvs-command-options mcvs-args)
123 (mcvs-generic "unedit" cvs-options cvs-command-options nil mcvs-args
124 :need-sync-before t
125 :need-sync-after t))
126
127 (defun mcvs-editors-wrapper (cvs-options cvs-command-options mcvs-args)
128 (mcvs-generic "editors" cvs-options cvs-command-options nil mcvs-args))
129
130 (defun mcvs-sync-to-wrapper (cvs-options cvs-command-options mcvs-args)
131 (mcvs-generic "" cvs-options cvs-command-options nil mcvs-args
132 :need-sync-before t
133 :no-invoke-cvs t))
134
135 (defun mcvs-sync-from-wrapper (cvs-options cvs-command-options mcvs-args)
136 (mcvs-generic "" cvs-options cvs-command-options nil mcvs-args
137 :need-sync-after t
138 :no-invoke-cvs t))

  ViewVC Help
Powered by ViewVC 1.1.5