/[meta-cvs]/meta-cvs/F-C232DEE072E25B4F4683B91342CEC065
ViewVC logotype

Contents of /meta-cvs/F-C232DEE072E25B4F4683B91342CEC065

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.15.2.1 - (hide annotations)
Fri Apr 5 00:02:06 2002 UTC (12 years ago) by kaz
Branch: deferred-adds-branch
Changes since 1.15: +2 -1 lines
Deferred adds feature, to get around the bug in cvs whereby
one cannot add files and then create a branch and switch to
it and commit them there.

add.lisp (mcvs-add): Do not execute cvs add commands, but instead
save them in a local MCVS metafile called ADD-LOCAL.
(complete-local-adds): New function, performs the deferred adds
and then removes ADD-LOCAL.
(mcvs-commit-wrapper): Function moved here out of generic.lisp.
Calls complete-local-adds before doing the commit.

generlic.lisp (mcvs-commit-wrapper): Function moved to add.lisp.

import.lisp (mcvs-import): Put ADD-LOCAL name under .cvsignore .

mapping.lisp (*mcvs-add-local-name*, *mcvs-add-local*): New
constants.
1 kaz 1.7 ;;; This source file is part of the Meta-CVS program,
2 kaz 1.4 ;;; which is distributed under the GNU license.
3     ;;; Copyright 2002 Kaz Kylheku
4    
5 kaz 1.1 (require "dirwalk")
6 kaz 1.10 (require "system")
7 kaz 1.1 (require "mapping")
8 kaz 1.10 (require "types")
9 kaz 1.1 (require "chatter")
10 kaz 1.6 (require "options")
11 kaz 1.1 (provide "import")
12    
13 kaz 1.2 (defun mcvs-import (module vendor release
14     &optional cvs-options import-options)
15 kaz 1.1 (multiple-value-bind (path created) (ensure-directories-exist *mcvs-map*)
16 kaz 1.3 (declare (ignore path))
17 kaz 1.1 (if (not created)
18 kaz 1.5 (error "mcvs-import: A ~a directory already exists here." *mcvs-dir*)))
19 kaz 1.1
20     (unwind-protect
21     (progn
22 kaz 1.10 (let (filemap types)
23 kaz 1.14 (chatter-debug "Mapping.~%")
24 kaz 1.10
25     ;; Gather up list of files to import, and build up mapping,
26     ;; as well as list of suffixes (file types).
27 kaz 1.1 (for-each-file-info (fi ".")
28     (when (regular-p fi)
29 kaz 1.10 (let* ((path (canonicalize-path (file-name fi)))
30     (suffix (suffix (file-name fi)))
31     (file (mapping-generate-name suffix)))
32 kaz 1.1 (chatter-info "~a <- ~a~%" file path)
33 kaz 1.10 (push (list file path) filemap)
34     (when suffix
35     (setf types (adjoin (list suffix :default)
36     types :test #'equal))))))
37    
38     ;; Write out types to file and allow user to edit.
39 kaz 1.13 (setf types (types-let-user-edit types *mcvs-types*))
40 kaz 1.10
41     ;; User has edited, so now we must honor all of the :IGNORE
42     ;; entries in the types, and remove the matching files from the
43     ;; mapping.
44 kaz 1.13 (setf filemap (types-remove-ignores types filemap))
45 kaz 1.10
46     ;; Create F-files by hard linking
47 kaz 1.1 (dolist (item filemap)
48     (link (second item) (first item)))
49    
50 kaz 1.15 ;; Write out mapping.
51 kaz 1.10 (mapping-write filemap *mcvs-map* :sort-map t)
52 kaz 1.15
53     ;; Create .cvsignore file.
54     (with-open-file (f (make-pathname :directory `(:relative ,*mcvs-dir*)
55     :name ".cvsignore")
56     :direction :output)
57 kaz 1.15.2.1 (write-line *mcvs-map-local-name* f)
58     (write-line *mcvs-add-local-name* f))
59 kaz 1.10
60     (loop
61     (restart-case
62     (current-dir-restore
63     (chdir *mcvs-dir*)
64 kaz 1.14 (chatter-debug "Invoking CVS.~%")
65 kaz 1.1
66 kaz 1.10 (if (not (execute-program `("cvs" ,@(format-opt cvs-options)
67     "import" ,@(format-opt import-options)
68     ,@(types-to-import-wrapper-args types)
69     ,module ,vendor ,release)))
70     (error "CVS import failed."))
71     (return))
72     (retry ()
73     :report "Try invoking CVS again.")))))
74 kaz 1.14 (chatter-debug "removing ~a directory~%" *mcvs-dir*)
75 kaz 1.1 (delete-recursive *mcvs-dir*))
76     (values))
77 kaz 1.2
78 kaz 1.6 (defun mcvs-import-wrapper (cvs-options cvs-command-options mcvs-args)
79 kaz 1.4 (if (< (length mcvs-args) 3)
80     (error "mcvs-import: specify module, vendor tag and release tag."))
81 kaz 1.2 (destructuring-bind (module vendor release &rest superfluous) mcvs-args
82     (when superfluous
83 kaz 1.4 (error "mcvs-import: specify only module, vendor tag and release tag."))
84 kaz 1.6 (mcvs-import module vendor release cvs-options cvs-command-options)))

  ViewVC Help
Powered by ViewVC 1.1.5