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

Contents of /meta-cvs/F-C232DEE072E25B4F4683B91342CEC065

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.7 - (hide annotations)
Thu Jan 31 05:35:02 2002 UTC (12 years, 2 months ago) by kaz
Branch: MAIN
Changes since 1.6: +1 -1 lines
MCVS is being renamed to Meta-CVS.
1 kaz 1.7 ;;; This source file is part of the Meta-CVS program,
2 kaz 1.4 ;;; which is distributed under the GNU license.
3     ;;; Copyright 2002 Kaz Kylheku
4    
5 kaz 1.1 (require "dirwalk")
6     (require "mapping")
7     (require "chatter")
8 kaz 1.6 (require "options")
9 kaz 1.1 (provide "import")
10    
11 kaz 1.2 (defun mcvs-import (module vendor release
12     &optional cvs-options import-options)
13 kaz 1.1 (multiple-value-bind (path created) (ensure-directories-exist *mcvs-map*)
14 kaz 1.3 (declare (ignore path))
15 kaz 1.1 (if (not created)
16 kaz 1.5 (error "mcvs-import: A ~a directory already exists here." *mcvs-dir*)))
17 kaz 1.1
18     (unwind-protect
19     (progn
20     (let (filemap)
21     (chatter-info "Mapping.~%")
22     (for-each-file-info (fi ".")
23     (when (regular-p fi)
24     (let ((path (canonicalize-path (file-name fi)))
25     (file (filemap-generate-name)))
26     (chatter-info "~a <- ~a~%" file path)
27     (push (list file path) filemap))))
28     (dolist (item filemap)
29     (link (second item) (first item)))
30     (with-open-file (file *mcvs-map* :direction :output)
31     (let ((*print-right-margin* 1))
32     (prin1 (filemap-sort filemap) file)
33     (terpri file))))
34    
35     (current-dir-restore
36     (chdir *mcvs-dir*)
37     (chatter-info "Invoking CVS.~%")
38 kaz 1.6 (execute-program `("cvs" ,@(format-opt cvs-options)
39     "import" ,@(format-opt import-options)
40 kaz 1.2 ,module ,vendor ,release))))
41 kaz 1.1
42     (chatter-info "removing ~a directory~%" *mcvs-dir*)
43     (delete-recursive *mcvs-dir*))
44     (values))
45 kaz 1.2
46 kaz 1.6 (defun mcvs-import-wrapper (cvs-options cvs-command-options mcvs-args)
47 kaz 1.4 (if (< (length mcvs-args) 3)
48     (error "mcvs-import: specify module, vendor tag and release tag."))
49 kaz 1.2 (destructuring-bind (module vendor release &rest superfluous) mcvs-args
50     (when superfluous
51 kaz 1.4 (error "mcvs-import: specify only module, vendor tag and release tag."))
52 kaz 1.6 (mcvs-import module vendor release cvs-options cvs-command-options)))

  ViewVC Help
Powered by ViewVC 1.1.5