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

Contents of /meta-cvs/F-233AD6EEE14894A7303F09519A2AB734

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.9 - (show annotations)
Sat Jan 26 17:14:33 2002 UTC (12 years, 2 months ago) by kaz
Branch: MAIN
CVS Tags: cvs-options-passthrough
Changes since 1.8: +2 -1 lines
Format string fixes.
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 (provide "mcvs-main")
16
17 (defconstant *mcvs-command-table*
18 `(("import" ,#'mcvs-import-wrapper)
19 ("checkout" ,#'mcvs-checkout-wrapper)
20 ("co" ,#'mcvs-checkout-wrapper)
21 ("add" ,#'mcvs-add-wrapper)
22 ("remove" ,#'mcvs-remove-wrapper)
23 ("rm" ,#'mcvs-remove-wrapper)
24 ("move" ,#'mcvs-move-wrapper)
25 ("mv" ,#'mcvs-move-wrapper)
26 ("update" ,#'mcvs-update-wrapper)
27 ("up" ,#'mcvs-update-wrapper)
28 ("commit" ,#'mcvs-commit-wrapper)
29 ("ci" ,#'mcvs-commit-wrapper)
30 ("diff" ,#'mcvs-diff-wrapper)))
31
32 (defun parse-args (args)
33 (values (first args) nil nil (rest args)))
34
35 (defun mcvs-execute (args)
36 (when (null args)
37 (error "mcvs: requires arguments."))
38 (multiple-value-bind (command-string cvs-options cvs-specific-options
39 mcvs-args) (parse-args args)
40 (let ((command (find command-string *mcvs-command-table* :key #'first
41 :test #'string=)))
42 (when (not command)
43 (error "mcvs: ~a is not a recognized mcvs command." command-string))
44 (funcall (second command) cvs-options cvs-specific-options mcvs-args))))
45
46 (defun mcvs-debug-shell ()
47 (let ((counter 0))
48 (loop
49 (format t "~&mcvs[~a]> " (incf counter))
50 (let ((line (string-trim #(#\space #\tab) (read-line))))
51 (can-restart-here ("Return to mcvs debug shell.~%")
52 (cond
53 ((zerop (length line)))
54 ((string-equal line "exit")
55 (return-from mcvs-debug-shell))
56 ((char-equal (char line 0) #\!)
57 (print (eval (read-from-string (subseq line 1)))))
58 (t (mcvs-execute (split-words line #(#\space #\tab))))))))))
59 #+clisp
60 (defun mcvs ()
61 (mcvs-execute ext:*args*))
62
63

  ViewVC Help
Powered by ViewVC 1.1.5