/[meta-cvs]/meta-cvs/F-94BF952D29F3DC3FFD457EFFCE570DB2
ViewVC logotype

Contents of /meta-cvs/F-94BF952D29F3DC3FFD457EFFCE570DB2

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (hide annotations)
Mon Feb 18 06:14:22 2002 UTC (12 years, 1 month ago) by kaz
Branch: MAIN
Changes since 1.1: +3 -3 lines
* print.lisp: New file.
(print-assoc-list): New function.
* types.lisp: Use print-assoc-list to nicely print the types.
* import.lisp (mcvs-import): Don't bother getting user to
edit the types if the type list is empty. In fact, don't
even create the file.

* add.lisp (mcvs-add): Use new form of mapping-generate-name.
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 "mapping")
6     (require "system")
7 kaz 1.2 (require "print")
8 kaz 1.1 (provide "types")
9    
10     (eval-when (:compile-toplevel :load-toplevel :execute)
11     (defconstant *mcvs-types-name* "TYPES"))
12    
13     (eval-when (:compile-toplevel :load-toplevel :execute)
14     (defconstant *mcvs-types* #.(path-cat *mcvs-dir* *mcvs-types-name*)))
15    
16     (defun types-read (filename)
17     (with-open-file (file filename :direction :input)
18     (read file)))
19    
20     (defun types-write (types filename &key comments)
21     (with-open-file (file filename :direction :output)
22 kaz 1.2 (let ((sorted-types (sort (copy-list types)
23 kaz 1.1 #'string-lessp :key #'first)))
24     (when comments
25     (write-string comments file)
26     (terpri file))
27 kaz 1.2 (print-assoc-list sorted-types file)
28 kaz 1.1 (terpri file))))
29    
30     (defun types-sanity-check (types)
31     (cond
32     ((null types)
33     (values))
34     ((consp types)
35     (let ((type-spec (first types)))
36     (when (or (not (stringp (first type-spec)))
37     (not (symbolp (second type-spec))))
38     (error "mcvs: bad syntax in file types specification: ~s" type-spec))
39     (when (not (member (second type-spec)
40     '(:name-only :keep-old :default :value-only
41     :binary :ignore)))
42     (error "mcvs: unrecognized keyword: ~s" type-spec)))
43     (types-sanity-check (rest types)))
44     (t (error "mcvs: bad syntax in file types specification: ~s" types))))
45    
46     (defun types-to-import-wrapper-args (types)
47     (mapcan #'(lambda (type-spec)
48     (destructuring-bind (suffix treatment) type-spec
49     (flet ((gen-option (suf opt) `("-W"
50     ,(format nil "*.~a -k '~a'"
51     suf opt))))
52     (ecase treatment
53     ((:name-only) (gen-option suffix "k"))
54     ((:keep-old) (gen-option suffix "o"))
55     ((:binary) (gen-option suffix "b"))
56     ((:value-only) (gen-option suffix "kv"))
57     ((:ignore) nil)
58     ((:default) nil)))))
59     types))

  ViewVC Help
Powered by ViewVC 1.1.5