/[meta-cvs]/meta-cvs/F-73871F8E513E48E095DE0FEFB1CFC48B
ViewVC logotype

Contents of /meta-cvs/F-73871F8E513E48E095DE0FEFB1CFC48B

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.6 - (hide annotations)
Sat Jan 26 01:38:37 2002 UTC (12 years, 2 months ago) by kaz
Branch: MAIN
Changes since 1.5: +10 -2 lines
Moving closer toward delivery.
1 kaz 1.1 (require "system")
2     (require "mapping")
3     (require "chatter")
4 kaz 1.4 (require "dirwalk")
5 kaz 1.6 (require "seqfuncs")
6 kaz 1.1 (provide "add")
7    
8 kaz 1.6 (defun mcvs-add (recursivep cvs-options add-options files)
9 kaz 1.4 (when (and recursivep (not (eq recursivep t)))
10     (error "mcvs-add: recursivep parameter should be NIL or T."))
11 kaz 1.3 (in-sandbox-root-dir
12     (let (filemap new-mcvs-files)
13 kaz 1.1 (with-open-file (file *mcvs-map* :direction :input)
14     (setf filemap (read file)))
15    
16     (chatter-info "Mapping.~%")
17 kaz 1.4
18 kaz 1.1 (dolist (file files)
19 kaz 1.4 (let (expanded-paths)
20     (if recursivep
21     (for-each-path (full-name (sandbox-translate-path file))
22 kaz 1.5 (push (canonicalize-path full-name) expanded-paths))
23 kaz 1.4 (push (sandbox-translate-path file) expanded-paths))
24     (nreverse expanded-paths)
25    
26 kaz 1.5 (dolist (full-name expanded-paths)
27     (can-restart-here ("Continue adding files.")
28 kaz 1.4 (cond
29 kaz 1.5 ((path-prefix-equal *mcvs-dir* full-name)
30     (error "mcvs-add: path ~a is in a MCVS meta-data area."
31     full-name))
32 kaz 1.4 ((filemap-lookup filemap full-name)
33     (chatter-terse "mcvs-add: ~a already added.~%" full-name))
34     ((directory-p full-name)
35     (when (not recursivep)
36     (error "mcvs-add: ~a, is a directory.~%" full-name)))
37     ((not (regular-p full-name))
38     (error "mcvs-add: cannot add ~a, not regular file.~%"
39     full-name))
40     (t
41     (let ((mcvs-file (filemap-generate-name)))
42     (chatter-info "~a <- ~a~%" mcvs-file full-name)
43     (link full-name mcvs-file)
44     (push (basename mcvs-file) new-mcvs-files)
45     (push (list mcvs-file full-name) filemap))))))))
46 kaz 1.1
47     (with-open-file (file *mcvs-map* :direction :output)
48     (let ((*print-right-margin* 1))
49     (prin1 (filemap-sort filemap) file)
50     (terpri file)))
51    
52     (when new-mcvs-files
53     (chatter-info "Synchronizing.~%")
54     (mapping-synchronize)
55    
56     (current-dir-restore
57     (chdir *mcvs-dir*)
58     (chatter-info "Invoking CVS.~%")
59 kaz 1.6 (execute-program `("cvs" ,@cvs-options "add" ,@add-options
60     ,@new-mcvs-files)))
61 kaz 1.1
62     (chatter-info "Updating file structure.~%")
63     (mapping-update))))
64     (values))
65 kaz 1.6
66     (defun mcvs-add-wrapper (cvs-options cvs-specific-options mcvs-args)
67     (multiple-value-bind (recursivep rest-add-options)
68     (separate "R" cvs-specific-options
69     :key #'first :test #'string=)
70     (mcvs-add recursivep cvs-options rest-add-options mcvs-args)))

  ViewVC Help
Powered by ViewVC 1.1.5