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

Contents of /meta-cvs/F-73871F8E513E48E095DE0FEFB1CFC48B

Parent Directory Parent Directory | Revision Log Revision Log


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

  ViewVC Help
Powered by ViewVC 1.1.5