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

Contents of /meta-cvs/F-73871F8E513E48E095DE0FEFB1CFC48B

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.12 - (hide annotations)
Fri Feb 1 02:23:46 2002 UTC (12 years, 2 months ago) by kaz
Branch: MAIN
CVS Tags: mcvs-0-3, mcvs-0-4, latest-patch
Changes since 1.11: +2 -2 lines
Renamed all ``filemap-'' functions to ``mapping-'' prefix.

* mapping.lisp (filemap-generate-name, filemap-sort,
filemap-extract-paths, filemap-lookup, filemap-prefix-lookup,
filemap-prefix-matches, filemap-object-lookup,
filemap-same-object-p, filemap-same-path-p, filemap-moved-p,
filemap-rename-files, filemap-sane-p): Old names removed.
(mapping-generate-name, mapping-sort,
mapping-extract-paths, mapping-lookup, mapping-prefix-lookup,
mapping-prefix-matches, mapping-object-lookup,
mapping-same-object-p, mapping-same-path-p, mapping-moved-p,
mapping-rename-files, mapping-sane-p): New names created.
(mapping-read, mapping-write, mapping-synchronize,
mapping-update): Edit calls to renamed functions.
* add.lisp (mcvs-add): Likewise.
* diff.lisp (mcvs-diff): Likewise.
* filt.lisp (mcvs-filt): Likewise.
* import.lisp (mcvs-import): Likewise.
* move.lisp (simple-rename, simple-move-to-dir, move-guts): Likewise.
* remove.lisp (mcvs-remove): Likewise.
1 kaz 1.10 ;;; This source file is part of the Meta-CVS program,
2 kaz 1.7 ;;; which is distributed under the GNU license.
3     ;;; Copyright 2002 Kaz Kylheku
4    
5 kaz 1.1 (require "system")
6     (require "mapping")
7     (require "chatter")
8 kaz 1.4 (require "dirwalk")
9 kaz 1.6 (require "seqfuncs")
10 kaz 1.8 (require "options")
11 kaz 1.1 (provide "add")
12    
13 kaz 1.6 (defun mcvs-add (recursivep cvs-options add-options files)
14 kaz 1.3 (in-sandbox-root-dir
15 kaz 1.11 (let ((filemap (mapping-read *mcvs-map*))
16     new-mcvs-files)
17 kaz 1.1
18     (chatter-info "Mapping.~%")
19 kaz 1.4
20 kaz 1.1 (dolist (file files)
21 kaz 1.4 (let (expanded-paths)
22     (if recursivep
23     (for-each-path (full-name (sandbox-translate-path file))
24 kaz 1.5 (push (canonicalize-path full-name) expanded-paths))
25 kaz 1.4 (push (sandbox-translate-path file) expanded-paths))
26     (nreverse expanded-paths)
27    
28 kaz 1.5 (dolist (full-name expanded-paths)
29     (can-restart-here ("Continue adding files.")
30 kaz 1.4 (cond
31 kaz 1.5 ((path-prefix-equal *mcvs-dir* full-name)
32 kaz 1.10 (error "mcvs-add: path ~a is in a reserved Meta-CVS area."
33 kaz 1.5 full-name))
34 kaz 1.12 ((mapping-lookup filemap full-name)
35 kaz 1.4 (chatter-terse "mcvs-add: ~a already added.~%" full-name))
36     ((directory-p full-name)
37     (when (not recursivep)
38     (error "mcvs-add: ~a, is a directory.~%" full-name)))
39     ((not (regular-p full-name))
40     (error "mcvs-add: cannot add ~a, not regular file.~%"
41     full-name))
42     (t
43 kaz 1.12 (let ((mcvs-file (mapping-generate-name)))
44 kaz 1.4 (chatter-info "~a <- ~a~%" mcvs-file full-name)
45     (link full-name mcvs-file)
46     (push (basename mcvs-file) new-mcvs-files)
47     (push (list mcvs-file full-name) filemap))))))))
48 kaz 1.1
49 kaz 1.11 (mapping-write filemap *mcvs-map* :sort-map t)
50 kaz 1.1
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 kaz 1.8 (execute-program `("cvs" ,@(format-opt cvs-options)
59     "add" ,@(format-opt add-options)
60 kaz 1.6 ,@new-mcvs-files)))
61 kaz 1.1
62     (chatter-info "Updating file structure.~%")
63     (mapping-update))))
64     (values))
65 kaz 1.6
66 kaz 1.8 (defun mcvs-add-wrapper (cvs-options cvs-command-options mcvs-args)
67 kaz 1.6 (multiple-value-bind (recursivep rest-add-options)
68 kaz 1.8 (separate "R" cvs-command-options
69 kaz 1.6 :key #'first :test #'string=)
70     (mcvs-add recursivep cvs-options rest-add-options mcvs-args)))

  ViewVC Help
Powered by ViewVC 1.1.5