/[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 - (show 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 (require "system")
2 (require "mapping")
3 (require "chatter")
4 (require "dirwalk")
5 (require "seqfuncs")
6 (provide "add")
7
8 (defun mcvs-add (recursivep cvs-options add-options files)
9 (when (and recursivep (not (eq recursivep t)))
10 (error "mcvs-add: recursivep parameter should be NIL or T."))
11 (in-sandbox-root-dir
12 (let (filemap new-mcvs-files)
13 (with-open-file (file *mcvs-map* :direction :input)
14 (setf filemap (read file)))
15
16 (chatter-info "Mapping.~%")
17
18 (dolist (file files)
19 (let (expanded-paths)
20 (if recursivep
21 (for-each-path (full-name (sandbox-translate-path file))
22 (push (canonicalize-path full-name) expanded-paths))
23 (push (sandbox-translate-path file) expanded-paths))
24 (nreverse expanded-paths)
25
26 (dolist (full-name expanded-paths)
27 (can-restart-here ("Continue adding files.")
28 (cond
29 ((path-prefix-equal *mcvs-dir* full-name)
30 (error "mcvs-add: path ~a is in a MCVS meta-data area."
31 full-name))
32 ((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
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 (execute-program `("cvs" ,@cvs-options "add" ,@add-options
60 ,@new-mcvs-files)))
61
62 (chatter-info "Updating file structure.~%")
63 (mapping-update))))
64 (values))
65
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