/[meta-cvs]/meta-cvs/F-993DC8DDEC493F0D641AC0C23DB6BAB0
ViewVC logotype

Diff of /meta-cvs/F-993DC8DDEC493F0D641AC0C23DB6BAB0

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

revision 1.23.2.2 by kaz, Sun Apr 13 06:22:43 2003 UTC revision 1.30 by kaz, Tue Nov 28 07:47:22 2006 UTC
# Line 2  Line 2 
2  ;;; which is distributed under the GNU license.  ;;; which is distributed under the GNU license.
3  ;;; Copyright 2002 Kaz Kylheku  ;;; Copyright 2002 Kaz Kylheku
4    
5  (require "system")  (in-package :meta-cvs)
 (require "mapping")  
 (require "chatter")  
 (require "find-bind")  
 (provide "remove")  
6    
7  (defun mcvs-remove (recursivep files &key no-sync)  (defun rm (recursivep files &key no-sync)
8    (when (null files)    (when (null files)
9      (return-from mcvs-remove (values)))      (return-from rm (values)))
10    
11    (in-sandbox-root-dir    (in-sandbox-root-dir
12      (let (files-to-remove (filemap (mapping-read *mcvs-map*)))      (let (files-to-remove (filemap (mapping-read *map-path*)))
13    
14        (chatter-debug "Unmapping.~%")        (chatter-debug "Unmapping.~%")
15        (dolist (file files)        (dolist (file files)
# Line 23  Line 19 
19                                (real-to-abstract-path full-name)))                                (real-to-abstract-path full-name)))
20                   (entries (mapping-prefix-matches filemap abs-name)))                   (entries (mapping-prefix-matches filemap abs-name)))
21              (cond              (cond
22                ((path-prefix-equal *mcvs-dir* full-name)                ((path-prefix-equal *admin-dir* full-name)
23                   (error "cannot remove ~a: path is in a reserved Meta-CVS area."                   (error "cannot remove ~a: path is in a reserved Meta-CVS area."
24                          full-name))                          full-name))
25                ((and (second entries) (not recursivep))                ((and (second entries) (not recursivep))
# Line 45  Line 41 
41            (mapping-synchronize :direction :left))            (mapping-synchronize :direction :left))
42          (let ((new-filemap (set-difference filemap files-to-remove          (let ((new-filemap (set-difference filemap files-to-remove
43                                             :test #'mapping-same-id-p)))                                             :test #'mapping-same-id-p)))
44            (mapping-write new-filemap *mcvs-map* :sort-map t))            (mapping-write new-filemap *map-path* :sort-map t))
45    
46          (chatter-debug "Updating file structure.~%")          (chatter-debug "Updating file structure.~%")
47          (mapping-update :no-delete-removed no-sync))))          (mapping-update :no-delete-removed no-sync))))
48    (values))    (values))
49    
50  (defun mcvs-remove-wrapper (cvs-options cvs-command-options mcvs-args)  (defun remove-wrapper (cvs-options cvs-command-options mcvs-args)
51    (declare (ignore cvs-options))    (declare (ignore cvs-options))
52    (find-bind (:test #'string= :key #'first)    (find-bind (:test #'string= :key #'first)
53               ((recursivep "R"))               ((recursivep "R"))
54               cvs-command-options               cvs-command-options
55      (mcvs-remove recursivep mcvs-args)))      (rm recursivep mcvs-args)))
56    
57  (defconstant *remove-help*  (defconstant *remove-help*
58  "Syntax:  "Syntax:

Legend:
Removed from v.1.23.2.2  
changed lines
  Added in v.1.30

  ViewVC Help
Powered by ViewVC 1.1.5