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

Contents of /meta-cvs/F-C232DEE072E25B4F4683B91342CEC065

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.14 - (show annotations)
Tue Mar 12 19:54:59 2002 UTC (12 years, 1 month ago) by kaz
Branch: MAIN
Changes since 1.13: +3 -3 lines
* update.lisp (mcvs-update): Changing level of chatter messages.
* move.lisp (mcvs-move): Likewise.
* add.lisp (mcvs-add): Likewise.
* remove.lisp (mcvs-remove): Likewise.
* checkout.lisp (mcvs-checkout): Likewise.
* generic.lisp (mcvs-generic): Likewise.
* import.lisp (mcvs-import): Likewise.
* mapping.lisp (mapping-dupe-check): Likewise.
(mapping-update): Likewise.
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, and we are ready to cvs import!
51 (mapping-write filemap *mcvs-map* :sort-map t)
52
53 (loop
54 (restart-case
55 (current-dir-restore
56 (chdir *mcvs-dir*)
57 (chatter-debug "Invoking CVS.~%")
58
59 (if (not (execute-program `("cvs" ,@(format-opt cvs-options)
60 "import" ,@(format-opt import-options)
61 ,@(types-to-import-wrapper-args types)
62 ,module ,vendor ,release)))
63 (error "CVS import failed."))
64 (return))
65 (retry ()
66 :report "Try invoking CVS again.")))))
67 (chatter-debug "removing ~a directory~%" *mcvs-dir*)
68 (delete-recursive *mcvs-dir*))
69 (values))
70
71 (defun mcvs-import-wrapper (cvs-options cvs-command-options mcvs-args)
72 (if (< (length mcvs-args) 3)
73 (error "mcvs-import: specify module, vendor tag and release tag."))
74 (destructuring-bind (module vendor release &rest superfluous) mcvs-args
75 (when superfluous
76 (error "mcvs-import: specify only module, vendor tag and release tag."))
77 (mcvs-import module vendor release cvs-options cvs-command-options)))

  ViewVC Help
Powered by ViewVC 1.1.5