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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.4 by kaz, Sat Oct 5 18:09:48 2002 UTC revision 1.4.2.1 by kaz, Sat Oct 26 18:40:27 2002 UTC
# Line 7  Line 7 
7  (require "mapping")  (require "mapping")
8  (require "find-bind")  (require "find-bind")
9    
10  (defun mcvs-purge (global-options purge-options)  (defun mcvs-purge (global-options)
11    (find-bind (:key #'first :test #'string= :take #'second)    (in-sandbox-root-dir
12               ((dry-run-only "n"))      (let* ((filemap (mapping-read *mcvs-map* :sanity-check t))
13               purge-options             (to-be-removed (mapping-removed-files filemap)))
14      (in-sandbox-root-dir        (when to-be-removed
15        (let* ((filemap (mapping-read *mcvs-map* :sanity-check t))          (chdir *mcvs-dir*)
16               (to-be-removed (mapping-removed-files filemap)))           (chatter-debug "Invoking CVS.~%")
17          (when to-be-removed           (unless (execute-program-xargs `("cvs" ,@(format-opt global-options)
18            (cond                                            "rm" "-f")
19              (dry-run-only                                          (mapcar #'basename to-be-removed))
20                 (dolist (tbr to-be-removed)             (error "CVS rm failed.")))))
                  (chatter-info "* purging ~a~%" tbr)))  
             (t (chdir *mcvs-dir*)  
                (chatter-debug "Invoking CVS.~%")  
                (unless (execute-program-xargs `("cvs" ,@(format-opt global-options)  
                                                 "rm" "-f")  
                                               (mapcar #'basename to-be-removed))  
                  (error "CVS rm failed."))))))))  
21    (values))    (values))
22    
23  (defun mcvs-purge-wrapper (global-options command-options args)  (defun mcvs-purge-wrapper (global-options command-options args)
24      (declare (ignore command-options))
25    (when args    (when args
26      (error "no arguments permitted."))      (error "no arguments permitted."))
27    (mcvs-purge global-options command-options))    (mcvs-purge global-options))

Legend:
Removed from v.1.4  
changed lines
  Added in v.1.4.2.1

  ViewVC Help
Powered by ViewVC 1.1.5