/[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 - (hide 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 kaz 1.7 ;;; This source file is part of the MCVS program,
2     ;;; which is distributed under the GNU license.
3     ;;; Copyright 2002 Kaz Kylheku
4    
5 kaz 1.1 (require "import")
6     (require "checkout")
7     (require "add")
8 kaz 1.3 (require "remove")
9 kaz 1.4 (require "move")
10 kaz 1.1 (require "update")
11     (require "commit")
12 kaz 1.2 (require "diff")
13 kaz 1.8 (require "split")
14     (require "restart")
15 kaz 1.6 (provide "mcvs-main")
16 kaz 1.5
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 kaz 1.8 (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 kaz 1.9 (can-restart-here ("Return to mcvs debug shell.~%")
52 kaz 1.8 (cond
53 kaz 1.9 ((zerop (length line)))
54 kaz 1.8 ((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 kaz 1.5 #+clisp
60     (defun mcvs ()
61     (mcvs-execute ext:*args*))
62 kaz 1.8
63    

  ViewVC Help
Powered by ViewVC 1.1.5