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

Contents of /meta-cvs/F-AFC09F145399B1273F4BF98702F5BE8C

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.26.2.2 - (hide annotations)
Sun Aug 25 18:20:45 2002 UTC (11 years, 8 months ago) by kaz
Branch: symlink-branch
CVS Tags: symlink-branch~merged-to-HEAD-0
Changes since 1.26.2.1: +1 -5 lines
* code/add.lisp (mcvs-add): Change to new mapping-entry data structure
and handle symbolic links.

* code/types.lisp (types-remove-ignores, types-make-cvs-adds):
Change to new mapping-entry data structure.

* code/mapping.lisp (mapping-generate-name): Renamed to
mapping-generate-id. Interface changes slightly.
(mapping-extract-kind): New function, factored out from mcvs-generic.
(mapping-update): Unlink existing symbolic link before
re-linking it.

* code/convert.lisp (mcvs-convert): Use new name and interface
of mapping-generate-name function.

* code/create.lisp (mcvs-create): Likewise.

* code/generic.lisp (mcvs-generic): Code to extract :file
entries from map factored out to mapping-extract-kind.
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.23 files &key need-sync-after default-include-meta-files
14 kaz 1.26 need-update-after no-fix-empty-file-list)
15 kaz 1.3 (in-sandbox-root-dir
16 kaz 1.13 (let (files-to-process
17 kaz 1.23 (filemap (mapping-read *mcvs-map-local*))
18     (do-meta-files (and (or *metaonly-option* *meta-option*
19 kaz 1.26 default-include-meta-files)
20     (not (and (null files)
21     no-fix-empty-file-list
22     (not *metaonly-option*)))
23 kaz 1.23 (not *nometa-option*))))
24 kaz 1.1
25 kaz 1.26 (unless (or *metaonly-option*)
26 kaz 1.23 (chatter-debug "Preparing file list.~%")
27 kaz 1.1
28 kaz 1.23 (if (null files)
29 kaz 1.26 (unless no-fix-empty-file-list
30     (setf files-to-process
31     (mapping-prefix-matches filemap
32     (sandbox-translate-path "."))))
33 kaz 1.23 (dolist (file files)
34     (can-restart-here ("Continue preparing file list.")
35     (let* ((full-name (sandbox-translate-path file))
36 kaz 1.25 (abs-name (real-to-abstract-path full-name))
37     (entries (mapping-prefix-matches filemap abs-name)))
38 kaz 1.23 (if (not entries)
39     (error "mcvs: ~a is not known to Meta-CVS." full-name)
40     (setf files-to-process (nconc files-to-process entries))))))))
41 kaz 1.22
42 kaz 1.26.2.2 (setf files-to-process (mapping-extract-kind files-to-process :file))
43 kaz 1.26.2.1
44 kaz 1.26 (when (or files-to-process
45     do-meta-files
46     no-fix-empty-file-list)
47 kaz 1.19 (chatter-debug "Synchronizing.~%")
48 kaz 1.1 (mapping-synchronize)
49    
50     (current-dir-restore
51     (chdir *mcvs-dir*)
52 kaz 1.19 (chatter-debug "Invoking CVS.~%")
53 kaz 1.12 (execute-program-xargs `("cvs" ,@(format-opt cvs-options)
54 kaz 1.13 ,cvs-command ,@(format-opt command-options)
55     ,@command-args)
56 kaz 1.23 `(,@(when do-meta-files
57 kaz 1.20 (let (metas)
58     (when (exists ".cvsignore")
59     (push ".cvsignore" metas))
60     (when (exists *mcvs-types-name*)
61     (push *mcvs-types-name* metas))
62     (cons *mcvs-map-name* metas)))
63 kaz 1.12 ,@(mapcar #'(lambda (x)
64 kaz 1.26.2.1 (basename
65     (mapping-entry-id x)))
66 kaz 1.21 files-to-process))))
67 kaz 1.23 (when (and do-meta-files need-update-after)
68     (chatter-debug "Updating file structure.~%")
69     (mapping-update))
70 kaz 1.21 (when need-sync-after
71     (chatter-debug "Synchronizing again.~%")
72     (mapping-synchronize))))
73 kaz 1.1 (values)))
74 kaz 1.18
75     (defun mcvs-commit-wrapper (cvs-options cvs-command-options mcvs-args)
76 kaz 1.23 (mcvs-generic "commit" cvs-options cvs-command-options nil mcvs-args
77 kaz 1.26 :default-include-meta-files t
78     :no-fix-empty-file-list t))
79 kaz 1.4
80 kaz 1.7 (defun mcvs-diff-wrapper (cvs-options cvs-command-options mcvs-args)
81 kaz 1.13 (mcvs-generic "diff" cvs-options cvs-command-options nil mcvs-args))
82    
83     (defun mcvs-tag-wrapper (cvs-options cvs-command-options mcvs-args)
84     (if (null mcvs-args)
85     (error "mcvs-tag: specify tag optionally followed by files."))
86     (mcvs-generic "tag" cvs-options
87 kaz 1.24 cvs-command-options (list (first mcvs-args)) (rest mcvs-args)
88     :default-include-meta-files t))
89 kaz 1.14
90     (defun mcvs-log-wrapper (cvs-options cvs-command-options mcvs-args)
91     (mcvs-generic "log" cvs-options cvs-command-options nil mcvs-args))
92    
93     (defun mcvs-status-wrapper (cvs-options cvs-command-options mcvs-args)
94     (mcvs-generic "status" cvs-options cvs-command-options nil mcvs-args))
95    
96     (defun mcvs-annotate-wrapper (cvs-options cvs-command-options mcvs-args)
97     (mcvs-generic "annotate" cvs-options cvs-command-options nil mcvs-args))

  ViewVC Help
Powered by ViewVC 1.1.5