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

Contents of /meta-cvs/F-C232DEE072E25B4F4683B91342CEC065

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.26.2.1 - (show annotations)
Sat Oct 26 18:54:43 2002 UTC (11 years, 5 months ago) by kaz
Branch: mcvs-1-0-branch
CVS Tags: mcvs-1-0, mcvs-0-99, mcvs-1-0-5, mcvs-1-0-4, mcvs-1-0-1, mcvs-1-0-2
Changes since 1.26: +5 -5 lines
* code/mcvs-main.lisp (*usage*): Expand tabs to spaces.

* code/add.lisp (*add-help*): Likewise.

* code/remove.lisp (*remove-help*): Likewise.

* code/create.lisp (*create-help*): 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 "create")
12
13 (defun mcvs-create (module release &optional global-options command-options)
14 (multiple-value-bind (path created) (ensure-directories-exist *mcvs-map*)
15 (declare (ignore path))
16 (if (not created)
17 (error "A ~a directory already exists here." *mcvs-dir*)))
18
19 (unwind-protect
20 (progn
21 (let (filemap types)
22 (chatter-debug "Mapping.~%")
23
24 ;; Gather up list of files to import, and build up mapping,
25 ;; as well as list of suffixes (file types).
26 (for-each-file-info (fi ".")
27 (cond
28 ((regular-p fi)
29 (let* ((path (canonicalize-path (file-name fi)))
30 (suffix (suffix (file-name fi)))
31 (file (mapping-generate-id :suffix suffix)))
32 (chatter-info "~a <- ~a~%" file path)
33 (push (make-mapping-entry :kind :file
34 :id file
35 :path path
36 :executable (executable-p
37 fi))
38 filemap)
39 (when suffix
40 (setf types (adjoin (list suffix :default)
41 types :test #'equal)))))
42 ((symlink-p fi)
43 (let ((path (canonicalize-path (file-name fi)))
44 (id (mapping-generate-id :prefix "S-" :no-dir t)))
45 (chatter-info "~a <- ~a~%" id path)
46 (push (make-mapping-entry :kind :symlink
47 :id id
48 :path path
49 :target (readlink path))
50 filemap)))))
51
52
53 ;; Write out types to file and allow user to edit.
54 (setf types (types-let-user-edit types *mcvs-types*))
55
56 ;; User has edited, so now we must honor all of the :IGNORE
57 ;; entries in the types, and remove the matching files from the
58 ;; mapping.
59 (setf filemap (types-remove-ignores types filemap))
60
61 ;; Create F-files by hard linking
62 (dolist (entry filemap)
63 (with-slots (kind id path) entry
64 (when (eq kind :file)
65 (link path id))))
66
67 ;; Write out mapping.
68 (mapping-write filemap *mcvs-map* :sort-map t)
69
70 ;; Create .cvsignore file.
71 (with-open-file (f (make-pathname :directory `(:relative ,*mcvs-dir*)
72 :name ".cvsignore")
73 :direction :output)
74 (write-line *mcvs-map-local-name* f)
75 (write-line *mcvs-displaced-name* f))
76
77 (loop
78 (restart-case
79 (current-dir-restore
80 (chdir *mcvs-dir*)
81 (chatter-debug "Invoking CVS.~%")
82
83 (if (not (execute-program `("cvs" ,@(format-opt global-options)
84 "import" "-I" "!"
85 ,@(format-opt command-options)
86 ,@(types-to-import-wrapper-args types)
87 ,module "Created-by-Meta-CVS" ,release)))
88 (error "CVS import failed."))
89 (return))
90 (retry ()
91 :report "Try invoking CVS again.")))))
92 (chatter-debug "removing ~a directory~%" *mcvs-dir*)
93 (delete-recursive *mcvs-dir*))
94 (values))
95
96 (defun mcvs-create-wrapper (cvs-options cvs-command-options mcvs-args)
97 (if (< (length mcvs-args) 2)
98 (error "specify module and release tag."))
99 (destructuring-bind (module release &rest superfluous) mcvs-args
100 (when superfluous
101 (error "specify only module and release tag."))
102 (mcvs-create module release cvs-options cvs-command-options)))
103
104 (defconstant *create-help*
105 "Syntax:
106
107 mcvs create [ options ] module-name release-tag
108
109 Options:
110
111 -d Use a file's modification time as time of creation.
112 -k subst-mode Set default RCS keyword substitution mode.
113 -I ignore-spec Specify files to ignore in addition to whatever
114 is specified interactively. May cause problems;
115 since Meta-CVS will map these files anwyay.
116 -b branch-num Vendor branch number for CVS import. Deprecated
117 brain-damage; you should never need this.
118 -m \"text ...\" Log message.
119 -W wrap-spec CVS wrappers specification line. Keep in mind that
120 Meta-CVS preserves suffixes only; CVS sees a
121 name like \"F-D3BC...30D5.html\".
122 Semantics:
123
124 The create command makes a new Meta-CVS module from the files and symbolic
125 links in the current directory, and all of its subdirectories. To work with
126 the newly created module, you must check it out to create a working copy.
127 The release-tag symbolically identifies the original baseline.
128
129 There are some interactive steps involved. If any of the files have
130 suffixes, like .c or .html, Meta-CVS will identify and tabulate them.
131 A text editor will pop up presenting you with an opportunity to edit
132 a symbolic specification that assigns to each file type a CVS keyword
133 expansion mode.")

  ViewVC Help
Powered by ViewVC 1.1.5