/[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.6 - (hide annotations)
Thu May 1 05:39:58 2003 UTC (10 years, 11 months ago) by kaz
Branch: mcvs-1-0-branch
CVS Tags: mcvs-1-0-8
Changes since 1.29.2.5: +2 -1 lines
* code/generic.lisp (mcvs-generic): The after-synchronization
was going in both directions rather than just MCVS -> tree.
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 kaz 1.29.2.4 files &key need-sync-before need-sync-after
14     default-include-meta-files need-update-after
15 kaz 1.29.2.5 global-if-empty-file-list no-invoke-cvs)
16 kaz 1.3 (in-sandbox-root-dir
17 kaz 1.13 (let (files-to-process
18 kaz 1.23 (filemap (mapping-read *mcvs-map-local*))
19     (do-meta-files (and (or *metaonly-option* *meta-option*
20 kaz 1.26 default-include-meta-files)
21     (not (and (null files)
22 kaz 1.29.2.3 global-if-empty-file-list
23 kaz 1.26 (not *metaonly-option*)))
24 kaz 1.23 (not *nometa-option*))))
25 kaz 1.1
26 kaz 1.26 (unless (or *metaonly-option*)
27 kaz 1.23 (chatter-debug "Preparing file list.~%")
28 kaz 1.1
29 kaz 1.23 (if (null files)
30 kaz 1.29.2.3 (unless global-if-empty-file-list
31 kaz 1.26 (setf files-to-process
32     (mapping-prefix-matches filemap
33     (sandbox-translate-path "."))))
34 kaz 1.23 (dolist (file files)
35     (can-restart-here ("Continue preparing file list.")
36     (let* ((full-name (sandbox-translate-path file))
37 kaz 1.29 (abs-name (canonicalize-path
38     (real-to-abstract-path full-name)))
39 kaz 1.25 (entries (mapping-prefix-matches filemap abs-name)))
40 kaz 1.23 (if (not entries)
41 kaz 1.28 (error "~a is not known to Meta-CVS." full-name)
42 kaz 1.23 (setf files-to-process (nconc files-to-process entries))))))))
43 kaz 1.22
44 kaz 1.27 (setf files-to-process (mapping-extract-kind files-to-process :file))
45    
46 kaz 1.26 (when (or files-to-process
47     do-meta-files
48 kaz 1.29.2.3 global-if-empty-file-list)
49 kaz 1.29.2.4 (when need-sync-before
50     (chatter-debug "Synchronizing.~%")
51     (mapping-synchronize :filemap files-to-process
52     :direction :left))
53 kaz 1.29.2.5 (unless no-invoke-cvs
54     (current-dir-restore
55     (chdir *mcvs-dir*)
56     (chatter-debug "Invoking CVS.~%")
57     (execute-program-xargs `("cvs" ,@(format-opt cvs-options)
58     ,cvs-command ,@(format-opt command-options)
59     ,@command-args)
60     `(,@(when do-meta-files
61     (let (metas)
62     (when (exists ".cvsignore")
63     (push ".cvsignore" metas))
64     (when (exists *mcvs-types-name*)
65     (push *mcvs-types-name* metas))
66     (cons *mcvs-map-name* metas)))
67     ,@(mapcar #'(lambda (x)
68     (basename
69     (mapping-entry-id x)))
70     files-to-process)))))
71 kaz 1.23 (when (and do-meta-files need-update-after)
72     (chatter-debug "Updating file structure.~%")
73     (mapping-update))
74 kaz 1.21 (when need-sync-after
75     (chatter-debug "Synchronizing again.~%")
76 kaz 1.29.2.6 (mapping-synchronize :filemap files-to-process
77     :direction :right))))
78 kaz 1.1 (values)))
79 kaz 1.18
80     (defun mcvs-commit-wrapper (cvs-options cvs-command-options mcvs-args)
81 kaz 1.23 (mcvs-generic "commit" cvs-options cvs-command-options nil mcvs-args
82 kaz 1.29.2.4 :need-sync-before t
83     :need-sync-after t
84 kaz 1.26 :default-include-meta-files t
85 kaz 1.29.2.3 :global-if-empty-file-list t))
86 kaz 1.4
87 kaz 1.7 (defun mcvs-diff-wrapper (cvs-options cvs-command-options mcvs-args)
88 kaz 1.29.2.4 (mcvs-generic "diff" cvs-options cvs-command-options nil mcvs-args
89     :need-sync-before t))
90 kaz 1.13
91     (defun mcvs-tag-wrapper (cvs-options cvs-command-options mcvs-args)
92     (if (null mcvs-args)
93 kaz 1.28 (error "specify tag optionally followed by files."))
94 kaz 1.13 (mcvs-generic "tag" cvs-options
95 kaz 1.24 cvs-command-options (list (first mcvs-args)) (rest mcvs-args)
96 kaz 1.29.2.3 :default-include-meta-files t
97     :global-if-empty-file-list t))
98 kaz 1.14
99     (defun mcvs-log-wrapper (cvs-options cvs-command-options mcvs-args)
100     (mcvs-generic "log" cvs-options cvs-command-options nil mcvs-args))
101    
102     (defun mcvs-status-wrapper (cvs-options cvs-command-options mcvs-args)
103 kaz 1.29.2.4 (mcvs-generic "status" cvs-options cvs-command-options nil mcvs-args
104     :need-sync-before t))
105 kaz 1.14
106     (defun mcvs-annotate-wrapper (cvs-options cvs-command-options mcvs-args)
107     (mcvs-generic "annotate" cvs-options cvs-command-options nil mcvs-args))
108 kaz 1.29.2.1
109     (defun mcvs-watchers-wrapper (cvs-options cvs-command-options mcvs-args)
110     (mcvs-generic "watchers" cvs-options cvs-command-options nil mcvs-args))
111    
112     (defun mcvs-edit-wrapper (cvs-options cvs-command-options mcvs-args)
113 kaz 1.29.2.4 (mcvs-generic "edit" cvs-options cvs-command-options nil mcvs-args
114     :need-sync-before t))
115 kaz 1.29.2.1
116     (defun mcvs-unedit-wrapper (cvs-options cvs-command-options mcvs-args)
117     (mcvs-generic "unedit" cvs-options cvs-command-options nil mcvs-args
118 kaz 1.29.2.4 :need-sync-before t
119 kaz 1.29.2.1 :need-sync-after t))
120    
121     (defun mcvs-editors-wrapper (cvs-options cvs-command-options mcvs-args)
122     (mcvs-generic "editors" cvs-options cvs-command-options nil mcvs-args))
123 kaz 1.29.2.5
124     (defun mcvs-sync-to-wrapper (cvs-options cvs-command-options mcvs-args)
125     (mcvs-generic "" cvs-options cvs-command-options nil mcvs-args
126     :need-sync-before t
127     :no-invoke-cvs t))
128    
129     (defun mcvs-sync-from-wrapper (cvs-options cvs-command-options mcvs-args)
130     (mcvs-generic "" cvs-options cvs-command-options nil mcvs-args
131     :need-sync-after t
132     :no-invoke-cvs t))

  ViewVC Help
Powered by ViewVC 1.1.5