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

Contents of /meta-cvs/F-AFC09F145399B1273F4BF98702F5BE8C

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.41 - (hide annotations)
Tue Nov 28 07:47:22 2006 UTC (7 years, 4 months ago) by kaz
Branch: MAIN
CVS Tags: asdf-import-branch~merged-to-HEAD-0, mcvs-1-1-98, asdf-import-branch~branch-point, HEAD
Branch point for: asdf-import-branch
Changes since 1.40: +5 -5 lines
More renaming to get rid of mcvs- prefix.

* code/chatter.lisp (*mcvs-debug*): Renamed to *chatter-debug*.
(*mcvs-info*, *mcvs-terse*, *mcvs-silent*): Similarly.
(*mcvs-chatter-level*): Renamed to *chatter-level*.

* code/unix.lisp (*mcvs-editor*): Renamed to *edit-program*.

* code/types.lisp (*mcvs-types-name*): Renamed to *types-file*.
(*mcvs-types*): Renamed to *types-path*.
(*mcvs-new-types*): Renamed to *types-new-path*.

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

  ViewVC Help
Powered by ViewVC 1.1.5