/[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 - (show 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 ;;; This source file is part of the Meta-CVS program,
2 ;;; which is distributed under the GNU license.
3 ;;; Copyright 2002 Kaz Kylheku
4
5 (require "dirwalk")
6 (require "system")
7 (require "mapping")
8 (require "types")
9 (require "chatter")
10 (require "options")
11 (provide "import")
12
13 (defun mcvs-import (module vendor release
14 &optional cvs-options import-options)
15 (multiple-value-bind (path created) (ensure-directories-exist *mcvs-map*)
16 (declare (ignore path))
17 (if (not created)
18 (error "mcvs-import: A ~a directory already exists here." *mcvs-dir*)))
19
20 (unwind-protect
21 (progn
22 (let (filemap types)
23 (chatter-debug "Mapping.~%")
24
25 ;; Gather up list of files to import, and build up mapping,
26 ;; as well as list of suffixes (file types).
27 (for-each-file-info (fi ".")
28 (when (regular-p fi)
29 (let* ((path (canonicalize-path (file-name fi)))
30 (suffix (suffix (file-name fi)))
31 (file (mapping-generate-name suffix)))
32 (chatter-info "~a <- ~a~%" file path)
33 (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 (setf types (types-let-user-edit types *mcvs-types*))
40
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 (setf filemap (types-remove-ignores types filemap))
45
46 ;; Create F-files by hard linking
47 (dolist (item filemap)
48 (link (second item) (first item)))
49
50 ;; Write out mapping.
51 (mapping-write filemap *mcvs-map* :sort-map t)
52
53 ;; Create .cvsignore file.
54 (with-open-file (f (make-pathname :directory `(:relative ,*mcvs-dir*)
55 :name ".cvsignore")
56 :direction :output)
57 (write-line *mcvs-map-local-name* f)
58 (write-line *mcvs-add-local-name* f))
59
60 (loop
61 (restart-case
62 (current-dir-restore
63 (chdir *mcvs-dir*)
64 (chatter-debug "Invoking CVS.~%")
65
66 (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 (chatter-debug "removing ~a directory~%" *mcvs-dir*)
75 (delete-recursive *mcvs-dir*))
76 (values))
77
78 (defun mcvs-import-wrapper (cvs-options cvs-command-options mcvs-args)
79 (if (< (length mcvs-args) 3)
80 (error "mcvs-import: specify module, vendor tag and release tag."))
81 (destructuring-bind (module vendor release &rest superfluous) mcvs-args
82 (when superfluous
83 (error "mcvs-import: specify only module, vendor tag and release tag."))
84 (mcvs-import module vendor release cvs-options cvs-command-options)))

  ViewVC Help
Powered by ViewVC 1.1.5