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

Contents of /meta-cvs/F-73871F8E513E48E095DE0FEFB1CFC48B

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (show annotations)
Sun Jan 20 07:12:03 2002 UTC (12 years, 3 months ago) by kaz
Branch: MAIN
Adding all existing source files.
1 (require "system")
2 (require "mapping")
3 (require "chatter")
4 (provide "add")
5
6 (defun mcvs-add (&rest files)
7 (current-dir-restore
8 (let ((down-path (mcvs-locate)) filemap new-mcvs-files)
9 (if (not down-path)
10 (error "mcvs-add: could not locate ~a directory." *mcvs-dir*))
11
12 (with-open-file (file *mcvs-map* :direction :input)
13 (setf filemap (read file)))
14
15 (chatter-info "Mapping.~%")
16 (dolist (file files)
17 (can-restart-here ("Continue adding files.")
18 (multiple-value-bind (full-name out-of-bounds)
19 (canonicalize-path (path-cat down-path file))
20 (cond
21 (out-of-bounds
22 (chatter-terse "mcvs-add: path ~a is not within sandbox."
23 full-name))
24 ((filemap-lookup filemap full-name)
25 (chatter-terse "mcvs-add: ~a already added.~%" full-name))
26 ((directory-p full-name)
27 (chatter-terse "mcvs-add: skipping directory ~a.~%" full-name))
28 ((not (regular-p full-name))
29 (chatter-terse "mcvs-add: skipping ~a, not regular file.~%"
30 full-name))
31 (t
32 (let ((mcvs-file (filemap-generate-name)))
33 (chatter-info "~a <- ~a~%" mcvs-file full-name)
34 (link full-name mcvs-file)
35 (push (basename mcvs-file) new-mcvs-files)
36 (push (list mcvs-file full-name) filemap)))))))
37
38 (with-open-file (file *mcvs-map* :direction :output)
39 (let ((*print-right-margin* 1))
40 (prin1 (filemap-sort filemap) file)
41 (terpri file)))
42
43 (when new-mcvs-files
44 (chatter-info "Synchronizing.~%")
45 (mapping-synchronize)
46
47 (current-dir-restore
48 (chdir *mcvs-dir*)
49 (chatter-info "Invoking CVS.~%")
50 (execute-program `("cvs" "add" ,@new-mcvs-files)))
51
52 (chatter-info "Updating file structure.~%")
53 (mapping-update))))
54 (values))

  ViewVC Help
Powered by ViewVC 1.1.5