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

Contents of /meta-cvs/F-C232DEE072E25B4F4683B91342CEC065

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.24 - (show annotations)
Tue Sep 17 03:34:25 2002 UTC (11 years, 7 months ago) by kaz
Branch: MAIN
CVS Tags: mcvs-0-95, mcvs-0-96
Changes since 1.23: +7 -1 lines
* code/mcvs-main.lisp (*checkout-options*): Removed -A and -N
options.
(*mcvs-command-table*): Added help for checkout and add.

* code/checkout.lisp (*checkout-help*): New string constant.

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

* code/create.lisp (*create-help*): Mention interactive file
type specification.
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 "mcvs-create: 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
76 (loop
77 (restart-case
78 (current-dir-restore
79 (chdir *mcvs-dir*)
80 (chatter-debug "Invoking CVS.~%")
81
82 (if (not (execute-program `("cvs" ,@(format-opt global-options)
83 "import" "-I" "!"
84 ,@(format-opt command-options)
85 ,@(types-to-import-wrapper-args types)
86 ,module "Created-by-Meta-CVS" ,release)))
87 (error "CVS import failed."))
88 (return))
89 (retry ()
90 :report "Try invoking CVS again.")))))
91 (chatter-debug "removing ~a directory~%" *mcvs-dir*)
92 (delete-recursive *mcvs-dir*))
93 (values))
94
95 (defun mcvs-create-wrapper (cvs-options cvs-command-options mcvs-args)
96 (if (< (length mcvs-args) 2)
97 (error "mcvs-create: specify module and release tag."))
98 (destructuring-bind (module release &rest superfluous) mcvs-args
99 (when superfluous
100 (error "mcvs-create: specify only module and release tag."))
101 (mcvs-create module release cvs-options cvs-command-options)))
102
103 (defconstant *create-help*
104 "Syntax:
105
106 mcvs create [ options ] module-name release-tag
107
108 Options:
109
110 -d Use a file's modification time as time of creation.
111 -k subst-mode Set default RCS keyword substitution mode.
112 -I ignore-spec Specify files to ignore in addition to whatever
113 is specified interactively. May cause problems;
114 since Meta-CVS will map these files anwyay.
115 -b branch-num Vendor branch number for CVS import. Deprecated
116 brain-damage; you should never need this.
117 -m \"text ...\" Log message.
118 -W wrap-spec CVS wrappers specification line. Keep in mind that
119 Meta-CVS preserves suffixes only; CVS sees a
120 name like \"F-D3BC...30D5.html\".
121 Semantics:
122
123 The create command makes a new Meta-CVS module from the files and symbolic
124 links in the current directory, and all of its subdirectories. To work with
125 the newly created module, you must check it out to create a working copy.
126 The release-tag symbolically identifies the original baseline.
127
128 There are some interactive steps involved. If any of the files have
129 suffixes, like .c or .html, Meta-CVS will identify and tabulate them.
130 A text editor will pop up presenting you with an opportunity to edit
131 a symbolic specification that assigns to each file type a CVS keyword
132 expansion mode.")

  ViewVC Help
Powered by ViewVC 1.1.5