/[meta-cvs]/meta-cvs/F-233AD6EEE14894A7303F09519A2AB734
ViewVC logotype

Contents of /meta-cvs/F-233AD6EEE14894A7303F09519A2AB734

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.79 - (hide annotations)
Thu Oct 31 04:06:01 2002 UTC (11 years, 5 months ago) by kaz
Branch: MAIN
Changes since 1.78: +6 -3 lines
* code/mcvs-package.lisp: New file, defines META-CVS package.

* code/purge.lisp: Put all symbols in new package.
* code/restore.lisp: Likewise.
* code/paths.lisp: Likewise.
* code/install.sh: Likewise.
* code/restart.lisp: Likewise.
* code/update.lisp: Likewise.
* code/move.lisp: Likewise.
* code/grab.lisp: Likewise.
* code/unix.lisp: Likewise.
* code/slot-refs.lisp: Likewise.
* code/prop.lisp: Likewise.
* code/multi-hash.lisp: Likewise.
* code/rcs-utils.lisp: Likewise.
* code/branch.lisp: Likewise.
* code/find-bind.lisp: Likewise.
* code/execute.lisp: Likewise.
* code/link.lisp: Likewise.
* code/split.lisp: Likewise.
* code/watch.lisp: Likewise.
* code/clisp-unix.lisp: Likewise.
* code/add.lisp: Likewise.
* code/chatter.lisp: Likewise.
* code/print.lisp: Likewise.
* code/types.lisp: Likewise.
* code/remove.lisp: Likewise.
* code/convert.lisp: Likewise.
* code/error.lisp: Likewise.
* code/options.lisp: Likewise.
* code/dirwalk.lisp: Likewise.
* code/checkout.lisp: Likewise.
* code/generic.lisp: Likewise.
* code/sync.lisp: Likewise.
* code/create.lisp: Likewise.
* code/memoize.lisp: Likewise.
* code/seqfuncs.lisp: Likewise.
* code/cmucl-unix.lisp: Likewise.
* code/remap.lisp: Likewise.

* code/mapping.lisp: Put symbols in new package. Replace use
of CLISP specific substring function with subseq.
* code/filt.lisp: Likewise.

* code/mcvs-main.lisp: Put symbols in new package. The mcvs
function is renamed to main.

* code/install.sh: Generate mcvs script that uses qualified name
of new startup functiont to start the software.
1 kaz 1.16 ;;; This source file is part of the Meta-CVS program,
2 kaz 1.7 ;;; which is distributed under the GNU license.
3     ;;; Copyright 2002 Kaz Kylheku
4    
5 kaz 1.75 ;; Clear out requires for mcvs-upgrade to work right.
6     (setf *modules* nil)
7    
8 kaz 1.45 (require "create")
9 kaz 1.1 (require "checkout")
10 kaz 1.46 (require "grab")
11 kaz 1.1 (require "add")
12 kaz 1.3 (require "remove")
13 kaz 1.4 (require "move")
14 kaz 1.78 (require "link")
15 kaz 1.1 (require "update")
16 kaz 1.12 (require "filt")
17 kaz 1.21 (require "generic")
18 kaz 1.25 (require "convert")
19 kaz 1.38 (require "branch")
20 kaz 1.44 (require "remap")
21 kaz 1.48 (require "purge")
22 kaz 1.49 (require "restore")
23 kaz 1.54 (require "prop")
24 kaz 1.72 (require "watch")
25 kaz 1.8 (require "split")
26     (require "restart")
27 kaz 1.27 (require "error")
28 kaz 1.10 (require "options")
29 kaz 1.33 (require "find-bind")
30 kaz 1.79 (require "mcvs-package")
31 kaz 1.6 (provide "mcvs-main")
32 kaz 1.5
33 kaz 1.79 (in-package "META-CVS")
34    
35 kaz 1.55 (define-option-constant *cvs-options*
36     (0 arg "H" "help" "Q" "q" "r" "w" "l" "n" "t" "v" "f" "version"
37 kaz 1.69 "meta" "metaonly" "nometa" "error-continue" "error-terminate"
38     "debug")
39 kaz 1.65 (1 arg "T" "e" "d" "r" "z" "s" "i"))
40 kaz 1.55
41 kaz 1.58 (define-option-constant *help-options*)
42    
43 kaz 1.55 (define-option-constant *create-options*
44     (0 arg "d")
45     (1 arg "k" "I" "b" "m" "W"))
46    
47     (define-option-constant *grab-options*
48     (0 arg "A")
49     (1 arg "r"))
50    
51     (define-option-constant *checkout-options*
52 kaz 1.61 (0 arg "f")
53 kaz 1.55 (1 arg "r" "D" "d" "k" "j"))
54    
55 kaz 1.71 (define-option-constant *export-options*
56     (0 arg "f")
57     (1 arg "r" "D" "d" "k"))
58    
59 kaz 1.55 (define-option-constant *add-options*
60     (0 arg "R")
61     (1 arg "k" "m"))
62    
63     (define-option-constant *remove-options*
64     (0 arg "R"))
65    
66     (define-option-constant *update-options*
67 kaz 1.70 (0 arg "A" "C" "f" "p")
68 kaz 1.55 (1 arg "k" "r" "D" "j" "I" "W"))
69    
70     (define-option-constant *switch-options*
71     (1 arg "k" "I" "W"))
72    
73     (define-option-constant *commit-options*
74     (0 arg "f")
75     (1 arg "F" "m" "r"))
76    
77     (define-option-constant *diff-options*
78     (0 arg "a" "b" "B" "brief" "c" "d" "e" "ed" "expand-tabs" "f" "forward-ed"
79     "H" "i" "ignore-all-space" "ignore-blank-lines" "ignore-case"
80     "ignore-space-change" "initial-tab" "l" "left-column" "minimal" "n"
81     "N" "new-file" "p" "P" "--paginate" "q" "rcs" "report-identical-files"
82     "s" "show-c-function" "side-by-side" "speed-large-files"
83     "suppress-common-lines" "t" "T" "text" "u" "unidirectional-new-file"
84     "w" "y")
85     (1 arg "C" "context" "D" "F" "horizon-lines" "ifdef" "ignore-matching-lines"
86     "L" "label" "line-format" "new-group-format" "new-line-format"
87     "old-group-format" "old-line-format" "r" "show-function-line"
88     "unchanged-group-format" "unchanged-line-format" "U" "unified" "W"
89     "width"))
90    
91     (define-option-constant *tag-options*
92     (0 arg "l" "d" "f" "b" "F" "c")
93     (1 arg "r" "D"))
94    
95     (define-option-constant *log-options*
96     (0 arg "R" "h" "t" "N" "b")
97     (1 arg "r" "d" "s" "w"))
98    
99     (define-option-constant *status-options*
100     (0 arg "v"))
101    
102     (define-option-constant *annotate-options*
103     (0 arg "f")
104     (1 arg "r" "D"))
105    
106     (define-option-constant *filt-options*
107     (1 arg "r" "D"))
108    
109 kaz 1.57 (define-option-constant *move-options*)
110 kaz 1.78 (define-option-constant *link-options*)
111 kaz 1.55 (define-option-constant *convert-options*)
112     (define-option-constant *branch-options*)
113     (define-option-constant *merge-options*)
114     (define-option-constant *remerge-options*)
115     (define-option-constant *list-branches-options*)
116     (define-option-constant *remap-options*)
117     (define-option-constant *purge-options*)
118     (define-option-constant *restore-options*)
119    
120     (define-option-constant *prop-options*
121     (1 arg "set" "clear" "remove")
122     (2 arg "value"))
123 kaz 1.18
124 kaz 1.72 (define-option-constant *watch-options*
125     (0 arg "on" "off")
126     (1 arg "add" "remove"))
127    
128 kaz 1.73 (define-option-constant *watchers-options*)
129     (define-option-constant *edit-options*)
130     (define-option-constant *unedit-options*)
131     (define-option-constant *editors-options*)
132    
133 kaz 1.58 (defun mcvs-help (global-options command-options args)
134     (declare (special *usage* *mcvs-command-table*)
135     (ignore global-options command-options))
136     (cond
137     ((null args)
138     (terpri)
139     (write-line *usage*)
140     (terpri))
141     ((= (length args) 1)
142     (let* ((command-name (first args))
143     (command (find command-name *mcvs-command-table*
144     :key #'first
145     :test #'string=)))
146     (when (null command)
147 kaz 1.69 (error "~a is not a recognized mcvs command."
148 kaz 1.58 command-name))
149 kaz 1.59 (let ((help-text (third command)))
150     (when (null help-text)
151 kaz 1.69 (error "sorry, no help available for ~a command."
152 kaz 1.58 command-name))
153 kaz 1.59 (terpri)
154     (write-line help-text)
155     (terpri))))
156 kaz 1.69 (t (error "try \"mcvs help <name-of-command>\"."))))
157 kaz 1.58
158 kaz 1.5 (defconstant *mcvs-command-table*
159 kaz 1.58 `(("help" ,#'mcvs-help nil ,*help-options*)
160 kaz 1.59 ("create" ,#'mcvs-create-wrapper ,*create-help* ,*create-options*)
161 kaz 1.60 ("grab" ,#'mcvs-grab-wrapper ,*grab-help* ,*grab-options*)
162 kaz 1.61 ("checkout" ,#'mcvs-checkout-wrapper ,*checkout-help* ,*checkout-options*)
163     ("co" ,#'mcvs-checkout-wrapper ,*checkout-help* ,*checkout-options*)
164 kaz 1.71 ("export" ,#'mcvs-export-wrapper ,*export-help* ,*export-options*)
165     ("ex" ,#'mcvs-export-wrapper ,*export-help* ,*export-options*)
166 kaz 1.61 ("add" ,#'mcvs-add-wrapper ,*add-help* ,*add-options*)
167 kaz 1.63 ("remove" ,#'mcvs-remove-wrapper ,*remove-help* ,*remove-options*)
168 kaz 1.64 ("rm" ,#'mcvs-remove-wrapper ,*remove-help* ,*remove-options*)
169 kaz 1.76 ("move" ,#'mcvs-move-wrapper ,*move-help* ,*move-options*)
170     ("mv" ,#'mcvs-move-wrapper ,*move-help* ,*move-options*)
171 kaz 1.78 ("link" ,#'mcvs-link-wrapper ,*link-help* ,*link-options*)
172     ("ln" ,#'mcvs-link-wrapper ,*link-help* ,*link-options*)
173 kaz 1.58 ("update" ,#'mcvs-update-wrapper nil ,*update-options*)
174     ("up" ,#'mcvs-update-wrapper nil ,*update-options*)
175     ("commit" ,#'mcvs-commit-wrapper nil ,*commit-options*)
176     ("ci" ,#'mcvs-commit-wrapper nil ,*commit-options*)
177     ("diff" ,#'mcvs-diff-wrapper nil ,*diff-options*)
178     ("tag" ,#'mcvs-tag-wrapper nil ,*tag-options*)
179     ("log" ,#'mcvs-log-wrapper nil ,*log-options*)
180     ("status" ,#'mcvs-status-wrapper nil ,*status-options*)
181     ("stat" ,#'mcvs-status-wrapper nil ,*status-options*)
182     ("annotate" ,#'mcvs-annotate-wrapper nil ,*annotate-options*)
183     ("filt" ,#'mcvs-filt-wrapper nil ,*filt-options*)
184     ("fi" ,#'mcvs-filt-wrapper nil ,*filt-options*)
185     ("convert" ,#'mcvs-convert-wrapper nil ,*convert-options*)
186     ("branch" ,#'mcvs-branch-wrapper nil ,*branch-options*)
187     ("switch" ,#'mcvs-switch-wrapper nil ,*switch-options*)
188     ("sw" ,#'mcvs-switch-wrapper nil ,*switch-options*)
189     ("merge" ,#'mcvs-merge-wrapper nil ,*merge-options*)
190     ("remerge" ,#'mcvs-remerge-wrapper nil ,*remerge-options*)
191     ("list-branches" ,#'mcvs-list-branches-wrapper nil ,*list-branches-options*)
192     ("lb" ,#'mcvs-list-branches-wrapper nil ,*list-branches-options*)
193     ("purge" ,#'mcvs-purge-wrapper nil ,*purge-options*)
194     ("restore" ,#'mcvs-restore-wrapper nil ,*restore-options*)
195     ("remap" ,#'mcvs-remap-wrapper nil ,*remap-options*)
196 kaz 1.72 ("prop" ,#'mcvs-prop-wrapper nil ,*prop-options*)
197 kaz 1.73 ("watch" ,#'mcvs-watch-wrapper nil ,*watch-options*)
198     ("watchers" ,#'mcvs-watchers-wrapper nil ,*watchers-options*)
199     ("edit" ,#'mcvs-edit-wrapper nil ,*edit-options*)
200     ("unedit" ,#'mcvs-unedit-wrapper nil ,*unedit-options*)
201     ("editors" ,#'mcvs-editors-wrapper nil ,*editors-options*)))
202 kaz 1.5
203 kaz 1.33 (defconstant *usage*
204     "Meta-CVS command syntax:
205    
206 kaz 1.59 mcvs [ global-options] command [ command-options ] [ command-arguments ]
207 kaz 1.33
208     Global options:
209    
210 kaz 1.35 -H --help Print this help and terminate. If a command is specified,
211     help specific to that command is printed instead.
212     -Q Very quiet, generate output only for serious problems. (*)
213     -q Somewhat quiet, some informational messages suppresed. (*)
214 kaz 1.69 --debug Verbose debug output; -Q and -q are ignored but still
215     passed to CVS.
216 kaz 1.35 -r Make working files read-only. (@)
217     -w Make new working files read-write (default). (@)
218     -l Do not log cvs command in command history, but execute
219     it anyway. (@)
220     -t Trace CVS execution. (@)
221     -v --version Display version information and terminate.
222     -f CVS not to read ~/.cvsrc file. (@)
223 kaz 1.65 -i script-name Load a Lisp file and evaluate its top level forms,
224     allowing Meta-CVS to behave as an interpreter.
225 kaz 1.50 --meta Include metafiles such as MCVS/MAP in the set of files
226     to operate on.
227     --metaonly Operate only on metafiles.
228     --nometa Exclude metafiles from the set of files to operate on.
229 kaz 1.35 --error-continue Instead of interactive error handling, automatically
230     continue all continuable errors.
231     --error-terminate Terminate without cleanup when an error happens instead
232     of interactive error handling (use with care).
233     -T tempdir Place temporary files in tempdir. (@)
234     -e editor Edit messages with editor. (*)
235     -d root Specify CVSROOT. (@)
236     -z gzip-level Specify compression level. (@)
237 kaz 1.33
238     Notes: (*) option processed by Meta-CVS and passed to CVS too.
239     (@) option merely passed to CVS.
240    
241     Commands:
242    
243 kaz 1.59 help Obtain more detailed help for a specific command.
244 kaz 1.45 create Create new project from an existing file tree.
245 kaz 1.46 grab Take a snapshot of an external source tree, such
246     as a third-party release, and incorporate it into
247     the working copy. Tries to discover file moves.
248 kaz 1.72 checkout (co) Retrieve a Meta-CVS project from the repository to
249     create a working copy.
250     export (ex) Retrieve a Meta-CVS project without creating a
251 kaz 1.35 working copy.
252     add Place files (or directories with add -R) under
253     version control.
254     remove (rm) Remove files or directories.
255     move (mv) Rename files and directories.
256 kaz 1.78 link (ln) Create a versioned symbolic link.
257 kaz 1.35 update (up) Incorporate latest changes from repository into
258     working copy.
259     commit (ci) Incorporate outstanding changes in the working copy
260     into the repository.
261     diff Compute differences between files in the working copy
262     and the repository or between revisions in the repository.
263     tag Associate a symbolic name with file revisions to create
264     an identifiable baseline. By default, tags the
265     revisions that were last synchronized with the
266     directory. A branch is created using tag -b.
267     log Display log information for files.
268     status (stat) Show current status of files.
269     annotate Perform a detailed analysis of files, showing the
270     version information about every individual line of text.
271     filt (fi) Act as a text filter, which converts Meta-CVS F- file
272     names to readable paths, according to the current mapping.
273 kaz 1.38 branch Create a managed branch. Meta-CVS managed branches keep
274     track of what has been merged where, so users don't have
275     to track merges with tags at all.
276     merge Merge a managed branch to the current branch or trunk.
277 kaz 1.40 remerge Re-apply the most recent merge without changing any tags.
278     Useful when a merge goes bad so the local changes have
279     to be discarded and the merge done over again.
280 kaz 1.41 list-branches (lb) List Meta-CVS managed branches.
281 kaz 1.43 switch (sw) Switch to a branch. With no arguments, switch to
282 kaz 1.42 main trunk.
283 kaz 1.44 remap Force Meta-CVS to notice and incorporate moves and
284     deletions that were performed directly on the sandbox.
285 kaz 1.48 purge Execute a CVS remove on files that have been unmapped
286     with the remove command.
287 kaz 1.51 restore Restore files that have been deleted with the remove
288     command, but not purged. These appear in the lost+found
289     directory under cryptic names.
290 kaz 1.54 prop Manipulate properties.
291 kaz 1.56 prop --set <bool-prop-name> [ files ... ]
292 kaz 1.77 prop --clear <bool-prop-name> [ files ... ]
293     prop --value <prop-name> <new-value> [ files ... ]
294     prop --remove <prop-name> [ files ... ]
295     The ``exec'' property represents the execute permission
296     of a file. More than one --set, --clear, --value
297     or --remove may be specified before the files.
298 kaz 1.72 watch Manipulate per-file CVS watch settings.
299     watch --on [ files ... ]
300     watch --off [ files ... ]
301     watch --add <action> [ files ... ]
302     watch --remove <action> [ files ... ]
303 kaz 1.73 watchers See who is watching files.
304     edit Indicate the intent to edit a watched file.
305     unedit Retract the indication signaled by edit.
306     editors See who is editing files.
307 kaz 1.35 convert Convert a CVS module to a Meta-CVS project. This requires
308     filesystem-level access to the repository. This is
309     currently an experimental command that is known not
310     to work 100%.")
311 kaz 1.33
312 kaz 1.68 (defvar *options*)
313 kaz 1.67 (defvar *args*)
314 kaz 1.66
315 kaz 1.5 (defun mcvs-execute (args)
316 kaz 1.27 (handler-bind ((error #'mcvs-error-handler))
317 kaz 1.18 (multiple-value-bind (global-options global-args)
318 kaz 1.55 (parse-opt args *cvs-options*)
319 kaz 1.33 (setf global-options (filter-global-options global-options))
320    
321     (find-bind (:test #'string= :key #'first)
322     ((help-long "help") (help "H") (quiet "q")
323 kaz 1.34 (very-quiet "Q") (version "v") (version-long "version")
324 kaz 1.65 (editor "e") (interpret-file "i"))
325 kaz 1.33 global-options
326 kaz 1.68 (setf *args* global-args)
327     (setf *options* global-options)
328 kaz 1.33 (when (or help-long help)
329     (terpri)
330     (write-line *usage*)
331     (terpri)
332     (throw 'mcvs-terminate nil))
333     (when (or version version-long)
334 kaz 1.34 (let* ((vers (split-words "$Name: $" "$:- "))
335 kaz 1.33 (major (third vers))
336     (minor (fourth vers)))
337     (if (and major minor)
338     (format t "Meta-CVS version ~a.~a (c) 2002 Kaz Kylheku~%"
339     major minor)
340     (format t "Meta-CVS unknown version (c) 2002 Kaz Kylheku~%"))
341 kaz 1.34 (throw 'mcvs-terminate nil)))
342     (when editor
343 kaz 1.74 (setf *mcvs-editor* (second editor)))
344 kaz 1.34 (cond
345     (very-quiet (setf *mcvs-chatter-level* *mcvs-silent*))
346 kaz 1.69 (quiet (setf *mcvs-chatter-level* *mcvs-terse*)))
347 kaz 1.65 (when interpret-file
348 kaz 1.66 (load (second interpret-file))
349     (throw 'mcvs-terminate nil)))
350 kaz 1.33
351 kaz 1.18 (when (not (first global-args))
352 kaz 1.35 (write-line "Meta-CVS requires a command argument.")
353 kaz 1.33 (write-line "Use mcvs -H to view help.")
354     (throw 'mcvs-terminate nil))
355    
356 kaz 1.18 (let ((command (find (first global-args) *mcvs-command-table*
357 kaz 1.55 :key #'first
358     :test #'string=)))
359 kaz 1.11 (when (not command)
360 kaz 1.69 (error "~a is not a recognized mcvs command."
361 kaz 1.18 (first global-args)))
362 kaz 1.58 (destructuring-bind (name func help-text opt-spec) command
363     (declare (ignore name help-text))
364 kaz 1.68 (multiple-value-bind (command-options command-args)
365     (parse-opt (rest global-args) opt-spec)
366     (funcall func global-options command-options command-args))))))
367 kaz 1.18 nil)
368 kaz 1.5
369 kaz 1.8 (defun mcvs-debug-shell ()
370 kaz 1.24 (let ((counter 0)
371     (*mcvs-error-treatment* :decline))
372     (loop
373     (format t "~&mcvs[~a]> " (incf counter))
374     (let ((line (string-trim #(#\space #\tab) (read-line))))
375 kaz 1.29 (restart-case
376 kaz 1.24 (cond
377     ((zerop (length line)))
378     ((string-equal line "exit")
379     (return-from mcvs-debug-shell))
380     ((char-equal (char line 0) #\!)
381     (print (eval (read-from-string (subseq line 1)))))
382 kaz 1.29 (t (mcvs-execute (split-words line #(#\space #\tab)))))
383 kaz 1.36 (debug () :report "Return to mcvs debug shell"
384 kaz 1.29 (terpri)))))))
385 kaz 1.10
386 kaz 1.5 #+clisp
387 kaz 1.79 (defun main ()
388     (ext:exit (catch 'mcvs-terminate (or (mcvs-execute ext:*args*)
389     *mcvs-errors-occured-p*))))

  ViewVC Help
Powered by ViewVC 1.1.5