ViewVC logotype

Contents of /meta-cvs/F-73871F8E513E48E095DE0FEFB1CFC48B

Parent Directory Parent Directory | Revision Log Revision Log

Revision 1.38 - (show annotations)
Tue Nov 28 04:12:08 2006 UTC (7 years, 4 months ago) by kaz
Branch: MAIN
Changes since 1.37: +3 -3 lines
Getting rid of mcvs- prefixes.

* code/package.lisp (defpackage): shadow the merge symbol.

* code/purge.lisp (mcvs-purge): renamed to purge
(mcvs-purge-wrapper): renamed to purge-wrapper

* code/restore.lisp (mcvs-restore): renamed to restore
(mcvs-restore-wrapper): renamed to restore-wrapper

* code/update.lisp (mcvs-update): renamed to update
(mcvs-update-wrapper): renamed to update-wrapper

* code/main.lisp (mcvs-help): renamed to help
(*mcvs-command-table*): renamed to *command-table*
(mcvs-terminate catch): renamed to terminate.

* code/execute.lisp (mcvs-execute): renamed to execute

* code/move.lisp (mcvs-move): renamed to move
(mcvs-move-wrapper): renamed to move-wrapper

* code/grab.lisp (mcvs-grab): renamed to grab
(mcvs-grab-wrapper): renamed to grab-wrapper

* code/prop.lisp (mcvs-prop): renamed to prop
(mcvs-prop-wrapper): renamed to prop-wrapper

* code/filt.lisp (mcvs-filt-loop): renamed to filt-loop
(mcvs-filt): renamed to filt
(mcvs-remote-filt): renamed to remote-filt
(mcvs-filt-wrapper): renamed to filt-wrapper
(mcvs-remote-filt-wrapper): renamed to remote-filt-wrapper

* code/branch.lisp (mcvs-branch): renamed to branch
(mcvs-branch-wrapper): renamed to branch-wrapper
(mcvs-merge): renamed to merge
(mcvs-list-branches): renamed to list-branches
(mcvs-merge-wrapper): renamed to merge-wrapper
(mcvs-remerge-wrapper): renamed to remerge-wrapper
(mcvs-list-branches-wrapper): renamed to list-branches-wrapper
(mcvs-switch-wrapper): renamed to switch-wrapper

* code/link.lisp (mcvs-link): renamed to ln
(mcvs-link-wrapper): renamed to link-wrapper

* code/watch.lisp (mcvs-watch): renamed to watch
(mcvs-watch-wrapper): renamed to watch-wrapper

* code/add.lisp (mcvs-add): renamed to add
(mcvs-add-wrapper): renamed to add-wrapper

* code/remove.lisp (mcvs-remove): renamed to rm
(mcvs-remove-wrapper): renamed to remove-wrapper

* code/convert.lisp (mcvs-convert): renamed to convert
(mcvs-convert-wrapper): renamed to convert-wrapper

* code/error.lisp (mcvs-terminate): renamed to terminate
(mcvs-error-handler): renamed to error-handler
(*mcvs-error-treatment*): renamed to *error-treatment*
(*mcvs-errors-occured-p*): renamed to *errors-occured-p*

* code/checkout.lisp (mcvs-checkout): renamed to checkout
(mcvs-checkout-wrapper): renamed to checkout-wrapper
(mcvs-export-wrapper): renamed to export-wrapper

* code/generic.lisp (mcvs-generic): renamed to generic
(mcvs-commit-wrapper): renamed to commit-wrapper
(mcvs-diff-wrapper): renamed to diff-wrapper
(mcvs-tag-wrapper): renamed to tag-wrapper
(mcvs-log-wrapper): renamed to log-wrapper
(mcvs-status-wrapper): renamed to status-wrapper
(mcvs-annotate-wrapper): renamed to annotate-wrapper
(mcvs-watchers-wrapper): renamed to watchers-wrapper
(mcvs-edit-wrapper): renamed to edit-wrapper
(mcvs-unedit-wrapper): renamed to unedit-wrapper
(mcvs-editors-wrapper): renamed to editors-wrapper
(mcvs-sync-to-wrapper): renamed to sync-to-wrapper
(mcvs-sync-from-wrapper): renamed to sync-from-wrapper

* code/create.lisp (mcvs-create): renamed to create
(mcvs-create-wrapper): renamed to create-wrapper

* code/remap.lisp (mcvs-remap): renamed to remap
(mcvs-remap-wrapper): renamed to remap-wrapper

* code/mapping.lisp (mcvs-locate): renamed to locate
1 ;;; This source file is part of the Meta-CVS program,
2 ;;; which is distributed under the GNU license.
3 ;;; Copyright 2002 Kaz Kylheku
5 (in-package :meta-cvs)
7 (defun add (recursivep cvs-options add-options files)
8 (in-sandbox-root-dir
9 (let* ((filemap (mapping-read *mcvs-map*))
10 (saved-filemap (copy-list filemap))
11 (types-exists (exists *mcvs-types*))
12 (types (and types-exists (types-read *mcvs-types*)))
13 new-map-entries new-types)
15 (chatter-debug "Mapping.~%")
17 (dolist (file files)
18 (let (expanded-paths)
19 (can-restart-here ("Continue processing arguments after ~a." file)
20 (if recursivep
21 (for-each-path (full-name (sandbox-translate-path file))
22 (push (canonicalize-path full-name) expanded-paths))
23 (push (sandbox-translate-path file) expanded-paths)))
24 (nreverse expanded-paths)
26 (dolist (full-name expanded-paths)
27 (can-restart-here ("Continue mapping files.")
28 (let ((abs-name (real-to-abstract-path full-name))
29 (file-info (stat full-name)))
30 (cond
31 ((path-prefix-equal *mcvs-dir* full-name)
32 (error "cannot add ~a: path is in a reserved Meta-CVS area."
33 full-name))
34 ((mapping-lookup filemap abs-name)
35 (chatter-info "~a already added.~%" full-name))
36 ((directory-p file-info)
37 (when (not recursivep)
38 (error "cannot add ~a: it is a directory, use -R to add." full-name)))
39 ((regular-p file-info)
40 (let* ((suffix (suffix full-name))
41 (f-file (mapping-generate-id :suffix suffix)))
42 (when suffix
43 (setf new-types (adjoin (list suffix :default)
44 new-types :test #'equal)))
45 (push (make-mapping-entry :kind :file
46 :id f-file
47 :path abs-name
48 :executable (executable-p
49 file-info))
50 new-map-entries)))
51 ((symlink-p file-info)
52 (let ((id (mapping-generate-id :no-dir t :prefix "S-")))
53 (push (make-mapping-entry :kind :symlink
54 :id id
55 :path abs-name
56 :target (readlink full-name))
57 new-map-entries)))
58 (t
59 (error "cannot add ~a: not regular file or symlink."
60 full-name))))))))
62 (setf new-types (set-difference
63 new-types types :key #'first :test #'string=))
65 (let ((*dry-run-option* nil))
66 (unwind-protect
67 (setf new-types (types-let-user-edit new-types *mcvs-new-types*))
68 (ignore-errors (unlink *mcvs-new-types*))))
70 (setf new-map-entries (types-remove-ignores new-types new-map-entries))
71 (setf new-map-entries (types-remove-ignores types new-map-entries))
73 (when new-map-entries
74 (dolist (map-entry new-map-entries)
75 (with-slots (kind id path) map-entry
76 (push map-entry filemap)
77 (let ((real-name (abstract-to-real-path path)))
78 (chatter-info "mapping ~a <- ~a~%" id real-name)
79 (if (eq kind :file)
80 (link real-name id)))))
82 (mapping-write filemap *mcvs-map* :sort-map t)
84 (when (setf types (append types new-types))
85 (types-write types *mcvs-types*))
87 (setf new-map-entries (mapping-extract-kind new-map-entries :file))
89 (let ((add-commands (types-make-cvs-adds types new-map-entries))
90 (restore-needed t))
91 (unwind-protect
92 (loop
93 (restart-case
94 (current-dir-restore
95 (chdir *mcvs-dir*)
96 (chatter-debug "Invoking CVS.~%")
97 (dolist (add-args add-commands)
98 (when (not (execute-program `("cvs" ,@(format-opt cvs-options)
99 "add" ,@(format-opt add-options)
100 ,@add-args)))
101 (error "CVS add failed.")))
102 (when (and types (not types-exists) (not *dry-run-option*))
103 (when (not (execute-program `("cvs" ,@(format-opt cvs-options)
104 "add" ,*mcvs-types-name*)))
105 (error "CVS add failed.")))
106 (setf restore-needed nil)
107 (return))
108 (retry ()
109 :report "Try invoking CVS again.")))
110 (when restore-needed
111 (chatter-terse "Undoing changes to map.~%")
112 (mapping-write saved-filemap *mcvs-map*)
113 (ignore-errors
114 (dolist (entry new-map-entries)
115 (unlink (mapping-entry-id entry)))))))
117 (chatter-debug "Updating file structure.~%")
118 (mapping-update))))
119 (values))
121 (defun add-wrapper (cvs-options cvs-command-options mcvs-args)
122 (multiple-value-bind (recursivep rest-add-options)
123 (separate "R" cvs-command-options
124 :key #'first :test #'string=)
125 (add recursivep cvs-options rest-add-options mcvs-args)))
127 (defconstant *add-help*
128 "Syntax:
130 mcvs add [ options ] objects ...
132 Options:
134 -R Recursive behavior: recursively add the contents
135 of all objects that are directories. By default,
136 trying to add a directory signals a continuable error.
137 -m \"text ...\" Use the specified text for the creation message.
138 -k key-expansion Add the file with the specified RCS expansion mode.
140 Semantics:
142 The add command brings local filesystem objects under version control.
143 The changes are not immediately incorporated into the repository; rather,
144 the addition a local change that is ``scheduled'' until the next commit
145 operation.
147 Objects that can be added are files and symbolic links. Directories are not
148 versioned objects in Meta-CVS; instead, files and symbolic links have a
149 pathname property which gives rise to the existence of directories in the
150 sandbox. The only significant consequence of this design choice is that empty
151 directories have no direct representation in Meta-CVS.
153 If any added files have suffixes that were not previously added to the
154 project before, Meta-CVS will pop up a text editor to allow you to edit
155 a specification that assigns to each new file type its CVS expansion
156 mode.")

  ViewVC Help
Powered by ViewVC 1.1.5