/[meta-cvs]/meta-cvs/F-0BAB20DD5AC6CA222E7E6E3055487AB2.lisp
ViewVC logotype

Contents of /meta-cvs/F-0BAB20DD5AC6CA222E7E6E3055487AB2.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (hide annotations)
Sun Jul 14 18:39:52 2002 UTC (11 years, 9 months ago) by kaz
Branch: MAIN
CVS Tags: mcvs-0-24, mcvs-0-20, symlink-branch~branch-point, mcvs-0-22, mcvs-0-23, mcvs-0-21, mcvs-0-95, mcvs-0-96, mcvs-0-19, symlink-branch~merged-to-HEAD-0
Branch point for: symlink-branch
Changes since 1.2: +1 -2 lines
Don't bind remaining options in find-bind, since they are not used.
1 kaz 1.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 "system")
6     (require "dirwalk")
7     (require "mapping")
8     (require "find-bind")
9    
10     (defun mcvs-purge (global-options purge-options)
11     (find-bind (:key #'first :test #'string= :take #'second)
12 kaz 1.3 ((dry-run-only "n"))
13 kaz 1.1 purge-options
14     (in-sandbox-root-dir
15 kaz 1.2 (let* ((filemap (mapping-read *mcvs-map* :sanity-check t))
16     (to-be-removed (mapping-removed-files filemap)))
17 kaz 1.1 (when to-be-removed
18     (cond
19     (dry-run-only
20     (dolist (tbr to-be-removed)
21     (chatter-info "* purging ~a~%" tbr)))
22     (t (chdir *mcvs-dir*)
23     (chatter-debug "Invoking CVS.~%")
24     (unless (execute-program-xargs `("cvs" ,@(format-opt global-options)
25     "rm" "-f")
26 kaz 1.2 (mapcar #'basename to-be-removed))
27 kaz 1.1 (error "CVS rm failed."))))))))
28     (values))
29    
30     (defun mcvs-purge-wrapper (global-options command-options args)
31     (when args
32     (error "mcvs-purge: no arguments permitted."))
33     (mcvs-purge global-options command-options))

  ViewVC Help
Powered by ViewVC 1.1.5