/[meta-cvs]/meta-cvs/F-36433FEEE65F109159A4ADF217F5145C
ViewVC logotype

Contents of /meta-cvs/F-36433FEEE65F109159A4ADF217F5145C

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.5 - (hide annotations)
Fri Feb 1 02:23:46 2002 UTC (12 years, 2 months ago) by kaz
Branch: MAIN
CVS Tags: mcvs-0-3, mcvs-0-6, mcvs-0-5, mcvs-0-4, latest-patch
Changes since 1.4: +1 -1 lines
Renamed all ``filemap-'' functions to ``mapping-'' prefix.

* mapping.lisp (filemap-generate-name, filemap-sort,
filemap-extract-paths, filemap-lookup, filemap-prefix-lookup,
filemap-prefix-matches, filemap-object-lookup,
filemap-same-object-p, filemap-same-path-p, filemap-moved-p,
filemap-rename-files, filemap-sane-p): Old names removed.
(mapping-generate-name, mapping-sort,
mapping-extract-paths, mapping-lookup, mapping-prefix-lookup,
mapping-prefix-matches, mapping-object-lookup,
mapping-same-object-p, mapping-same-path-p, mapping-moved-p,
mapping-rename-files, mapping-sane-p): New names created.
(mapping-read, mapping-write, mapping-synchronize,
mapping-update): Edit calls to renamed functions.
* add.lisp (mcvs-add): Likewise.
* diff.lisp (mcvs-diff): Likewise.
* filt.lisp (mcvs-filt): Likewise.
* import.lisp (mcvs-import): Likewise.
* move.lisp (simple-rename, simple-move-to-dir, move-guts): Likewise.
* remove.lisp (mcvs-remove): Likewise.
1 kaz 1.3 ;;; This source file is part of the Meta-CVS program,
2 kaz 1.1 ;;; which is distributed under the GNU license.
3     ;;; Copyright 2002 Kaz Kylheku
4    
5     (require "system")
6     (require "mapping")
7     (provide "filt")
8    
9     (defun mcvs-filt ()
10     (in-sandbox-root-dir
11 kaz 1.4 (let ((filemap (mapping-read *mcvs-map-local*)))
12 kaz 1.1 (loop
13     (let ((line (read-line t nil)))
14     (when (null line)
15     (return (values)))
16     (loop
17     (let ((f-start (search "F-" line)))
18     (flet ((is-hex-digit (x)
19     (or (digit-char-p x)
20 kaz 1.2 (find x "ABCDEF"))))
21 kaz 1.1 (when (not f-start)
22     (write-line line)
23     (return))
24     (write-string (substring line 0 f-start))
25     (setf line (substring line (+ f-start 2)))
26     (when (or (< (length line) 32)
27     (notevery #'is-hex-digit (substring line 0 32)))
28     (write-string "F-")
29     (write-line line)
30     (return))
31     (let* ((f-digits (substring line 0 32))
32 kaz 1.5 (entry (mapping-object-lookup filemap
33 kaz 1.3 (path-cat *mcvs-dir*
34     (format nil "F-~a"
35     f-digits)))))
36 kaz 1.1 (setf line (substring line 32))
37     (if (not entry)
38     (progn
39     (write-string "F-")
40     (write-string f-digits))
41     (write-string (second entry))))))))))))
42    
43     (defun mcvs-filt-wrapper (cvs-options cvs-command-options mcvs-args)
44     (declare (ignore cvs-options cvs-command-options))
45     (when mcvs-args
46     (error "mcvs-filt: no arguments permitted."))
47     (mcvs-filt))

  ViewVC Help
Powered by ViewVC 1.1.5