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

Contents of /meta-cvs/F-C232DEE072E25B4F4683B91342CEC065

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.35 - (show annotations)
Tue Nov 28 07:47:22 2006 UTC (7 years, 4 months ago) by kaz
Branch: MAIN
CVS Tags: asdf-import-branch~merged-to-HEAD-0, mcvs-1-1-98, asdf-import-branch~branch-point, HEAD
Branch point for: asdf-import-branch
Changes since 1.34: +14 -14 lines
More renaming to get rid of mcvs- prefix.

* code/chatter.lisp (*mcvs-debug*): Renamed to *chatter-debug*.
(*mcvs-info*, *mcvs-terse*, *mcvs-silent*): Similarly.
(*mcvs-chatter-level*): Renamed to *chatter-level*.

* code/unix.lisp (*mcvs-editor*): Renamed to *edit-program*.

* code/types.lisp (*mcvs-types-name*): Renamed to *types-file*.
(*mcvs-types*): Renamed to *types-path*.
(*mcvs-new-types*): Renamed to *types-new-path*.

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

  ViewVC Help
Powered by ViewVC 1.1.5