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

Contents of /meta-cvs/F-36433FEEE65F109159A4ADF217F5145C

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (hide annotations)
Sun Jan 27 19:42:02 2002 UTC (12 years, 2 months ago) by kaz
Branch: MAIN
Added mcvs filt command to decode F- names in text streams.
1 kaz 1.1 ;;; This source file is part of the MCVS program,
2     ;;; 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     (let ((filemap (with-open-file (file *mcvs-map-local* :direction :input)
12     (read file))))
13     (loop
14     (let ((line (read-line t nil)))
15     (when (null line)
16     (return (values)))
17     (loop
18     (let ((f-start (search "F-" line)))
19     (flet ((is-hex-digit (x)
20     (or (digit-char-p x)
21     (find x "ABCDEFabcdef"))))
22     (when (not f-start)
23     (write-line line)
24     (return))
25     (write-string (substring line 0 f-start))
26     (setf line (substring line (+ f-start 2)))
27     (when (or (< (length line) 32)
28     (notevery #'is-hex-digit (substring line 0 32)))
29     (write-string "F-")
30     (write-line line)
31     (return))
32     (let* ((f-digits (substring line 0 32))
33     (entry (filemap-object-lookup filemap
34     (format nil "MCVS/F-~a"
35     f-digits))))
36     (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