/[meta-cvs]/meta-cvs/F-BE2DE9340254D8E8E6E2649A55D3A742
ViewVC logotype

Contents of /meta-cvs/F-BE2DE9340254D8E8E6E2649A55D3A742

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.7 - (show annotations)
Thu Oct 31 04:06:01 2002 UTC (11 years, 5 months ago) by kaz
Branch: MAIN
Changes since 1.6: +3 -0 lines
* code/mcvs-package.lisp: New file, defines META-CVS package.

* code/purge.lisp: Put all symbols in new package.
* code/restore.lisp: Likewise.
* code/paths.lisp: Likewise.
* code/install.sh: Likewise.
* code/restart.lisp: Likewise.
* code/update.lisp: Likewise.
* code/move.lisp: Likewise.
* code/grab.lisp: Likewise.
* code/unix.lisp: Likewise.
* code/slot-refs.lisp: Likewise.
* code/prop.lisp: Likewise.
* code/multi-hash.lisp: Likewise.
* code/rcs-utils.lisp: Likewise.
* code/branch.lisp: Likewise.
* code/find-bind.lisp: Likewise.
* code/execute.lisp: Likewise.
* code/link.lisp: Likewise.
* code/split.lisp: Likewise.
* code/watch.lisp: Likewise.
* code/clisp-unix.lisp: Likewise.
* code/add.lisp: Likewise.
* code/chatter.lisp: Likewise.
* code/print.lisp: Likewise.
* code/types.lisp: Likewise.
* code/remove.lisp: Likewise.
* code/convert.lisp: Likewise.
* code/error.lisp: Likewise.
* code/options.lisp: Likewise.
* code/dirwalk.lisp: Likewise.
* code/checkout.lisp: Likewise.
* code/generic.lisp: Likewise.
* code/sync.lisp: Likewise.
* code/create.lisp: Likewise.
* code/memoize.lisp: Likewise.
* code/seqfuncs.lisp: Likewise.
* code/cmucl-unix.lisp: Likewise.
* code/remap.lisp: Likewise.

* code/mapping.lisp: Put symbols in new package. Replace use
of CLISP specific substring function with subseq.
* code/filt.lisp: Likewise.

* code/mcvs-main.lisp: Put symbols in new package. The mcvs
function is renamed to main.

* code/install.sh: Generate mcvs script that uses qualified name
of new startup functiont to start the software.
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 "system")
6 (require "mcvs-package")
7 (provide "sync")
8
9 (in-package "META-CVS")
10
11 (defun synchronize-files (left-file right-file should-be-executable)
12 "Ensure that the two files have the same contents, using any means,
13 including the possibility of making them hard links to the same object.
14 If they are already the same object, nothing happens and the symbol
15 :same is returned. Otherwise the newer one prevails, and clobbers the older
16 one; the symbols :left or :right are returned to indicate which prevailed. If
17 one of them doesn't exist, then it is created. If neither exists, nothing
18 happens, and NIL is returned. If either file is actually a directory,
19 :dir is returned"
20 (flet ((exec-check (file-info)
21 (if should-be-executable
22 (make-executable file-info)
23 (make-non-executable file-info))))
24 (let ((left (exists left-file))
25 (right (exists right-file)))
26 (cond
27 ((not (or left right))
28 nil)
29 ((or (directory-p left) (directory-p right))
30 :dir)
31 ((not right)
32 (ensure-directories-exist right-file)
33 (link left-file right-file)
34 (exec-check left-file)
35 :left)
36 ((not left)
37 (ensure-directories-exist left-file)
38 (link right-file left-file)
39 (exec-check right-file)
40 :right)
41 ((same-file-p right left)
42 (exec-check right-file)
43 :same)
44 ((older-p left right)
45 (unlink left-file)
46 (link right-file left-file)
47 (exec-check right-file)
48 :right)
49 ((older-p right left)
50 (unlink right-file)
51 (link left-file right-file)
52 (exec-check left-file)
53 :left)
54 (t
55 (restart-case
56 (error "~a and ~a have the same modification time."
57 left-file right-file)
58 (:choose-left () :report (lambda (s)
59 (format s "take ~a; clobber ~a."
60 left-file right-file))
61 (unlink right-file)
62 (link left-file right-file)
63 (exec-check left-file)
64 :left)
65 (:choose-right () :report (lambda (s)
66 (format s "take ~a; clobber ~a."
67 right-file left-file))
68 (unlink left-file)
69 (link right-file left-file)
70 (exec-check right-file)
71 :right)))))))

  ViewVC Help
Powered by ViewVC 1.1.5