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

Contents of /meta-cvs/F-C232DEE072E25B4F4683B91342CEC065

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.10 - (hide annotations)
Sat Feb 16 19:41:43 2002 UTC (12 years, 2 months ago) by kaz
Branch: MAIN
Changes since 1.9: +93 -11 lines
Support for filetypes in import.

* posix.lisp (suffix): Separator character parameter is optional;
multiple occurences of character lead to one big suffix like
".tar.gz" instead of ".gz".  A leading dot means it's not a suffix but
a hidden file like ".exrc".
(edit-file): New function, brings up text editor for specified file.

* clisp-linux.lisp (env-lookup): New function for environment
variable lookup.

* types.lisp: New source file.
(*mcvs-types-name*, *mcvs-types*): New constants for TYPES filename.
(types-read, types-write, types-sanity-check,
types-to-import-wrapper-args): New functions.

* import.lisp (*types-comments*): New constant.
(mcvs-import): Restructured to build up list of file suffixes,
allow the user to edit the file which determines how they
are treated, filter out ignored files and pass -W options to cvs import
to handle the rest. Failed cvs import is turned into restartable
condition.

* mapping.lisp (mapping-generate-name): Takes a suffix parameter.
The F-files now carry a suffix obtained from the original file,
because I have concluded that this was the only reasonable way
to integrate with CVS.
1 kaz 1.7 ;;; This source file is part of the Meta-CVS program,
2 kaz 1.4 ;;; which is distributed under the GNU license.
3     ;;; Copyright 2002 Kaz Kylheku
4    
5 kaz 1.1 (require "dirwalk")
6 kaz 1.10 (require "system")
7 kaz 1.1 (require "mapping")
8 kaz 1.10 (require "types")
9 kaz 1.1 (require "chatter")
10 kaz 1.6 (require "options")
11 kaz 1.1 (provide "import")
12    
13 kaz 1.10 (defconstant *types-comments*
14     ";;; These file type suffixes exist in the fileset you are trying to import.
15     ;;; By editing the form below, you can specify the CVS keyword substitution
16     ;;; mode for each file type. If there are any binary files, it is strongly
17     ;;; recommended that you identify them and set their mode to :binary.
18     ;;; These are the symbols you can specify:
19     ;;;
20     ;;; :default Expand keyword using default form. (CVS -kkv)
21     ;;;
22     ;;; Example: $Revision$ -> $ Revision: 1.2 $
23     ;;;
24     ;;; :name-only Expand only the keyword name on checkout. (CVS -kk)
25     ;;;
26     ;;; Example: $Revision$ -> $Revision$
27     ;;;
28     ;;; :keep-old Do not expand keywords, and keep any CVS/RCS keywords
29     ;;; that are already present in the files. (CVS -ko)
30     ;;;
31     ;;; Example: $Revision: 1.2 $ -> $Revision: 1.2 $
32     ;;;
33     ;;; :binary Like :keep-old except that the file is treated as
34     ;;; binary. Not only are keywords not expanded, but line ending
35     ;;; conversions are not performed either. (CVS -kb)
36     ;;;
37     ;;; :value-only Expand only the keyword value. (CVS -kv)
38     ;;;
39     ;;; Example: $Revision$ -> 1.2
40     ;;;
41     ;;; :ignore Do not import or add these files.
42     ")
43    
44 kaz 1.2 (defun mcvs-import (module vendor release
45     &optional cvs-options import-options)
46 kaz 1.1 (multiple-value-bind (path created) (ensure-directories-exist *mcvs-map*)
47 kaz 1.3 (declare (ignore path))
48 kaz 1.1 (if (not created)
49 kaz 1.5 (error "mcvs-import: A ~a directory already exists here." *mcvs-dir*)))
50 kaz 1.1
51     (unwind-protect
52     (progn
53 kaz 1.10 (let (filemap types)
54 kaz 1.1 (chatter-info "Mapping.~%")
55 kaz 1.10
56     ;; Gather up list of files to import, and build up mapping,
57     ;; as well as list of suffixes (file types).
58 kaz 1.1 (for-each-file-info (fi ".")
59     (when (regular-p fi)
60 kaz 1.10 (let* ((path (canonicalize-path (file-name fi)))
61     (suffix (suffix (file-name fi)))
62     (file (mapping-generate-name suffix)))
63 kaz 1.1 (chatter-info "~a <- ~a~%" file path)
64 kaz 1.10 (push (list file path) filemap)
65     (when suffix
66     (setf types (adjoin (list suffix :default)
67     types :test #'equal))))))
68    
69     ;; Write out types to file and allow user to edit.
70     (types-write types *mcvs-types* :comments *types-comments*)
71    
72     (loop
73     (restart-case
74     (progn
75     (chatter-info "Editing types.~%")
76     (edit-file *mcvs-types*)
77     (let ((edited-types (types-read *mcvs-types*)))
78     (types-sanity-check edited-types)
79     (types-write edited-types *mcvs-types*)
80     (setf types edited-types)))
81     (retry ()
82     :report "Correct file type treatment, try again.")
83     (restore-types ()
84     :report "Revert to original file treatment and edit again."
85     (types-write types *mcvs-types* :comments *types-comments*)))
86     (return))
87    
88     ;; User has edited, so now we must honor all of the :IGNORE
89     ;; entries in the types, and remove the matching files from the
90     ;; mapping.
91     (let ((ignores (mapcan #'(lambda (type-spec)
92     (if (eq (second type-spec) :ignore)
93     (list (first type-spec))))
94     types)))
95     (setf filemap (remove-if #'(lambda (name)
96     (member (suffix name)
97     ignores :test #'path-equal))
98     filemap :key #'first)))
99    
100     ;; Create F-files by hard linking
101 kaz 1.1 (dolist (item filemap)
102     (link (second item) (first item)))
103    
104 kaz 1.10 ;; Write out mapping, and we are ready to cvs import!
105     (mapping-write filemap *mcvs-map* :sort-map t)
106    
107     (loop
108     (restart-case
109     (current-dir-restore
110     (chdir *mcvs-dir*)
111     (chatter-info "Invoking CVS.~%")
112 kaz 1.1
113 kaz 1.10 (if (not (execute-program `("cvs" ,@(format-opt cvs-options)
114     "import" ,@(format-opt import-options)
115     ,@(types-to-import-wrapper-args types)
116     ,module ,vendor ,release)))
117     (error "CVS import failed."))
118     (return))
119     (retry ()
120     :report "Try invoking CVS again.")))))
121 kaz 1.1 (chatter-info "removing ~a directory~%" *mcvs-dir*)
122     (delete-recursive *mcvs-dir*))
123     (values))
124 kaz 1.2
125 kaz 1.6 (defun mcvs-import-wrapper (cvs-options cvs-command-options mcvs-args)
126 kaz 1.4 (if (< (length mcvs-args) 3)
127     (error "mcvs-import: specify module, vendor tag and release tag."))
128 kaz 1.2 (destructuring-bind (module vendor release &rest superfluous) mcvs-args
129     (when superfluous
130 kaz 1.4 (error "mcvs-import: specify only module, vendor tag and release tag."))
131 kaz 1.6 (mcvs-import module vendor release cvs-options cvs-command-options)))

  ViewVC Help
Powered by ViewVC 1.1.5