-
-
Notifications
You must be signed in to change notification settings - Fork 24
/
Copy pathCOMPARE-PATHS
86 lines (74 loc) · 4.74 KB
/
COMPARE-PATHS
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP")
(FILECREATED "22-Sep-87 15:19:06" {ERINYES}<LISPUSERS>LYRIC>COMPARE-PATHS.\;3 4836
|changes| |to:| (FUNCTIONS XCL-USER::COMPARE-PATHS XCL-USER::COMPARE-FLOPPY)
(VARS COMPARE-PATHSCOMS)
|previous| |date:| "22-Sep-87 12:03:37" {ERINYES}<LISPUSERS>LYRIC>COMPARE-PATHS.\;1)
; Copyright (c) 1987 by Xerox Corporation. All rights reserved.
(PRETTYCOMPRINT COMPARE-PATHSCOMS)
(RPAQQ COMPARE-PATHSCOMS ((FUNCTIONS XCL-USER::COMPARE-FLOPPY XCL-USER::COMPARE-PATHS)))
(CL:DEFUN XCL-USER::COMPARE-FLOPPY (XCL-USER::FLOPPYPATH XCL-USER::FSPATH)
(* |;;;| "This resoundingly dumb function walks IL:COMPARESOURCES down the files of two directories.")
(LET* ((XCL-USER::FLOPPYFILES (DIRECTORY XCL-USER::FLOPPYPATH))
(XCL-USER::FSFILES (DIRECTORY XCL-USER::FSPATH)))
(WHILE (AND XCL-USER::FLOPPYFILES XCL-USER::FSFILES) BIND XCL-USER::FLOPPYNAME
XCL-USER::FSNAME
DO (CL:SETQ XCL-USER::FLOPPYNAME (CL:PATHNAME-NAME (PATHNAME (CAR XCL-USER::FLOPPYFILES))))
(CL:SETQ XCL-USER::FSNAME (CL:PATHNAME-NAME (PATHNAME (CAR XCL-USER::FSFILES))))
(COND
((CL:STRING= XCL-USER::FLOPPYNAME XCL-USER::FSNAME)
(LET ((XCL-USER::FLOPPYDATE (GETFILEINFO (CAR XCL-USER::FLOPPYFILES)
'CREATIONDATE))
(XCL-USER::FSDATE (GETFILEINFO (CAR XCL-USER::FSFILES)
'CREATIONDATE)))
(IF (NOT (CL:STRING= XCL-USER::FLOPPYDATE XCL-USER::FSDATE))
THEN (CL:FORMAT T "Creation dates for ~s don't match:~%~S: ~S ~S: ~S ~2%"
XCL-USER::FLOPPYNAME (CAR XCL-USER::FLOPPYFILES)
XCL-USER::FLOPPYDATE
(CAR XCL-USER::FSFILES)
XCL-USER::FSDATE)
ELSE (COMPARESOURCES (CAR XCL-USER::FLOPPYFILES)
(CAR XCL-USER::FSFILES))
(CL:FORMAT T "~%")))
(CL:POP XCL-USER::FLOPPYFILES)
(CL:POP XCL-USER::FSFILES))
((CL:STRING< XCL-USER::FLOPPYNAME XCL-USER::FSNAME)
(CL:FORMAT T "File ~S not found on ~S~%" (CAR XCL-USER::FLOPPYFILES)
XCL-USER::FSPATH)
(CL:POP XCL-USER::FLOPPYFILES))
(T (CL:POP XCL-USER::FSFILES))))
(WHILE XCL-USER::FLOPPYFILES DO (CL:FORMAT T "File ~S not found on ~S~%" (CAR
XCL-USER::FLOPPYFILES
)
XCL-USER::FSPATH)
(CL:POP XCL-USER::FLOPPYFILES))))
(CL:DEFUN XCL-USER::COMPARE-PATHS (XCL-USER::PATH1 XCL-USER::PATH2)
(* |;;;| "This resoundingly dumb function walks IL:COMPARESOURCES down the files of two directories.")
(LET* ((XCL-USER::PL1 (DIRECTORY XCL-USER::PATH1))
(XCL-USER::PL2 (DIRECTORY XCL-USER::PATH2)))
(WHILE (AND XCL-USER::PL1 XCL-USER::PL2) BIND XCL-USER::PN1 XCL-USER::PN2
DO (CL:SETQ XCL-USER::PN1 (CL:PATHNAME-NAME (PATHNAME (CAR XCL-USER::PL1))))
(CL:SETQ XCL-USER::PN2 (CL:PATHNAME-NAME (PATHNAME (CAR XCL-USER::PL2))))
(COND
((CL:STRING= XCL-USER::PN1 XCL-USER::PN2)
(COMPARESOURCES (CAR XCL-USER::PL1)
(CAR XCL-USER::PL2))
(CL:FORMAT T "~%")
(CL:POP XCL-USER::PL1)
(CL:POP XCL-USER::PL2))
((CL:STRING< XCL-USER::PN1 XCL-USER::PN2)
(CL:FORMAT T "File ~S not found on ~S~%" (CAR XCL-USER::PL1)
XCL-USER::PATH2)
(CL:POP XCL-USER::PL1))
(T (CL:FORMAT T "File ~S not found on ~S~%" (CAR XCL-USER::PL2)
XCL-USER::PATH1)
(CL:POP XCL-USER::PL2))))
(WHILE XCL-USER::PL1 DO (CL:FORMAT T "File ~S not found on ~S~%" (CAR XCL-USER::PL1)
XCL-USER::PATH2)
(CL:POP XCL-USER::PL1))
(WHILE XCL-USER::PL2 DO (CL:FORMAT T "File ~S not found on ~S~%" (CAR XCL-USER::PL2)
XCL-USER::PATH1)
(CL:POP XCL-USER::PL2))))
(PUTPROPS COMPARE-PATHS COPYRIGHT ("Xerox Corporation" 1987))
(DECLARE\: DONTCOPY
(FILEMAP (NIL)))
STOP