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

Contents of /meta-cvs/F-233AD6EEE14894A7303F09519A2AB734

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.10 - (show annotations)
Sun Jan 27 16:33:13 2002 UTC (12 years, 2 months ago) by kaz
Branch: MAIN
Changes since 1.9: +27 -7 lines
First cut at pass-through of CVS options.
1 ;;; This source file is part of the MCVS program,
2 ;;; which is distributed under the GNU license.
3 ;;; Copyright 2002 Kaz Kylheku
4
5 (require "import")
6 (require "checkout")
7 (require "add")
8 (require "remove")
9 (require "move")
10 (require "update")
11 (require "commit")
12 (require "diff")
13 (require "split")
14 (require "restart")
15 (require "options")
16 (provide "mcvs-main")
17
18 (defconstant *mcvs-command-table*
19 `(("import" ,#'mcvs-import-wrapper)
20 ("checkout" ,#'mcvs-checkout-wrapper)
21 ("co" ,#'mcvs-checkout-wrapper)
22 ("add" ,#'mcvs-add-wrapper)
23 ("remove" ,#'mcvs-remove-wrapper)
24 ("rm" ,#'mcvs-remove-wrapper)
25 ("move" ,#'mcvs-move-wrapper)
26 ("mv" ,#'mcvs-move-wrapper)
27 ("update" ,#'mcvs-update-wrapper)
28 ("up" ,#'mcvs-update-wrapper)
29 ("commit" ,#'mcvs-commit-wrapper)
30 ("ci" ,#'mcvs-commit-wrapper)
31 ("diff" ,#'mcvs-diff-wrapper)))
32
33 (defun mcvs-execute (args)
34 (when (null args)
35 (error "mcvs: requires arguments."))
36 (multiple-value-bind (command-string cvs-options cvs-command-options
37 mcvs-args) (parse-args args)
38 (let ((command (find command-string *mcvs-command-table* :key #'first
39 :test #'string=)))
40 (when (not command)
41 (error "mcvs: ~a is not a recognized mcvs command." command-string))
42 (funcall (second command) cvs-options cvs-command-options mcvs-args))))
43
44 (defun mcvs-debug-shell ()
45 (let ((counter 0))
46 (loop
47 (format t "~&mcvs[~a]> " (incf counter))
48 (let ((line (string-trim #(#\space #\tab) (read-line))))
49 (can-restart-here ("Return to mcvs debug shell.~%")
50 (cond
51 ((zerop (length line)))
52 ((string-equal line "exit")
53 (return-from mcvs-debug-shell))
54 ((char-equal (char line 0) #\!)
55 (print (eval (read-from-string (subseq line 1)))))
56 (t (mcvs-execute (split-words line #(#\space #\tab))))))))))
57
58 (defconstant *cvs-options*
59 '("H" "help" "Q" "q" "f" "l" "n" "t" "r" "v" "--version" "w" "x"))
60
61 (defconstant *cvs-options-arg*
62 '("b" "d" "e" "z"))
63
64 (defconstant *cvs-command-options*
65 '("A" "f" "H" "help" "l" "n" "P" "p" "R"))
66
67 (defconstant *cvs-command-options-arg*
68 '("D" "k" "r" "j" "m"))
69
70 (defun parse-args (args)
71 (multiple-value-bind (cvs-options args)
72 (parse-opt args *cvs-options* *cvs-options-arg* "mcvs")
73 (let ((command (first args)))
74 (multiple-value-bind (cvs-command-options args)
75 (parse-opt (rest args)
76 *cvs-command-options*
77 *cvs-command-options-arg*
78 "mcvs")
79 (values command cvs-options cvs-command-options args)))))
80
81 #+clisp
82 (defun mcvs ()
83 (mcvs-execute ext:*args*))

  ViewVC Help
Powered by ViewVC 1.1.5