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

Contents of /meta-cvs/F-233AD6EEE14894A7303F09519A2AB734

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.30 - (show annotations)
Sun Mar 10 00:43:09 2002 UTC (12 years, 1 month ago) by kaz
Branch: MAIN
Changes since 1.29: +1 -1 lines
* mcvs-main.lisp (*add-options*): Support -R option for add.
Thus, recursive add works now.
1 ;;; This source file is part of the Meta-CVS 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 "filt")
13 (require "generic")
14 (require "convert")
15 (require "split")
16 (require "restart")
17 (require "error")
18 (require "options")
19 (provide "mcvs-main")
20
21 (defconstant *cvs-options*
22 '("H" "help" "Q" "q" "r" "w" "l" "n" "t" "v" "f" "a" "version"))
23
24 (defconstant *cvs-options-arg* '("T" "e" "d" "z" "s"))
25
26 (defconstant *import-options* '(("d") ("k" "I" "b" "m" "W")))
27 (defconstant *checkout-options* '(("A" "N" "f") ("r" "D" "d" "k" "j")))
28 (defconstant *add-options* '(("R") ("k" "m")))
29 (defconstant *remove-options* '(("R") ()))
30 (defconstant *update-options* '(("A" "f") ("k" "r" "D" "j" "I" "W")))
31 (defconstant *commit-options* '(("f") ("F" "m" "r")))
32 (defconstant *diff-options* '(("a" "b" "B" "brief" "c" "d" "e" "ed"
33 "expand-tabs" "f" "forward-ed" "H" "i"
34 "ignore-all-space" "ignore-blank-lines"
35 "ignore-case" "ignore-space-change"
36 "initial-tab" "l" "left-column" "minimal"
37 "n" "N" "new-file" "p" "P" "--paginate" "q"
38 "rcs" "report-identical-files" "s"
39 "show-c-function" "side-by-side"
40 "speed-large-files" "suppress-common-lines"
41 "t" "T" "text" "u" "unidirectional-new-file"
42 "w" "y")
43 ("C" "context" "D" "F" "horizon-lines" "ifdef"
44 "ignore-matching-lines" "L" "label"
45 "line-format" "new-group-format"
46 "new-line-format" "old-group-format"
47 "old-line-format" "r" "show-function-line"
48 "unchanged-group-format" "unchanged-line-format"
49 "U" "unified" "W" "width")))
50 (defconstant *tag-options* '(("l" "d" "f" "b" "F" "c") ("r" "D")))
51 (defconstant *log-options* '(("R" "h" "t" "N" "b") ("r" "d" "s" "w")))
52 (defconstant *status-options* '(("v") ()))
53 (defconstant *annotate-options* '(("f") ("r" "D")))
54 (defconstant *convert-options* '(() ()))
55
56 (defconstant *mcvs-command-table*
57 `(("import" ,#'mcvs-import-wrapper ,@*import-options*)
58 ("checkout" ,#'mcvs-checkout-wrapper ,@*checkout-options*)
59 ("co" ,#'mcvs-checkout-wrapper ,@*checkout-options*)
60 ("add" ,#'mcvs-add-wrapper ,@*add-options*)
61 ("remove" ,#'mcvs-remove-wrapper ,@*remove-options*)
62 ("rm" ,#'mcvs-remove-wrapper ,@*remove-options*)
63 ("move" ,#'mcvs-move-wrapper nil nil)
64 ("mv" ,#'mcvs-move-wrapper nil nil)
65 ("update" ,#'mcvs-update-wrapper ,@*update-options*)
66 ("up" ,#'mcvs-update-wrapper ,@*update-options*)
67 ("commit" ,#'mcvs-commit-wrapper ,@*commit-options*)
68 ("ci" ,#'mcvs-commit-wrapper ,@*commit-options*)
69 ("diff" ,#'mcvs-diff-wrapper ,@*diff-options*)
70 ("tag" ,#'mcvs-tag-wrapper ,@*tag-options*)
71 ("log" ,#'mcvs-log-wrapper ,@*log-options*)
72 ("status" ,#'mcvs-status-wrapper ,@*status-options*)
73 ("stat" ,#'mcvs-status-wrapper ,@*status-options*)
74 ("annotate" ,#'mcvs-annotate-wrapper ,@*annotate-options*)
75 ("filt" ,#'mcvs-filt-wrapper nil nil)
76 ("fi" ,#'mcvs-filt-wrapper nil nil)
77 ("convert" ,#'mcvs-convert-wrapper ,@*convert-options*)))
78
79 (defun mcvs-execute (args)
80 (handler-bind ((error #'mcvs-error-handler))
81 (multiple-value-bind (global-options global-args)
82 (parse-opt args *cvs-options*
83 *cvs-options-arg* "mcvs")
84 (when (not (first global-args))
85 (error "mcvs: requires arguments."))
86 (let ((command (find (first global-args) *mcvs-command-table*
87 :key #'first
88 :test #'string=)))
89 (when (not command)
90 (error "mcvs: ~a is not a recognized mcvs command."
91 (first global-args)))
92 (destructuring-bind (name func noarg-opts arg-opts) command
93 (declare (ignore name))
94 (multiple-value-bind (command-options command-args)
95 (parse-opt (rest global-args)
96 noarg-opts arg-opts "mcvs")
97 (funcall func global-options command-options command-args))))))
98 nil)
99
100 (defun mcvs-debug-shell ()
101 (let ((counter 0)
102 (*mcvs-error-treatment* :decline))
103 (loop
104 (format t "~&mcvs[~a]> " (incf counter))
105 (let ((line (string-trim #(#\space #\tab) (read-line))))
106 (restart-case
107 (cond
108 ((zerop (length line)))
109 ((string-equal line "exit")
110 (return-from mcvs-debug-shell))
111 ((char-equal (char line 0) #\!)
112 (print (eval (read-from-string (subseq line 1)))))
113 (t (mcvs-execute (split-words line #(#\space #\tab)))))
114 (continue () :report "Return to mcvs debug shell"
115 (terpri)))))))
116
117 #+clisp
118 (defun mcvs ()
119 (exit (catch 'mcvs-terminate (or (mcvs-execute ext:*args*)
120 *mcvs-errors-occured-p*))))

  ViewVC Help
Powered by ViewVC 1.1.5