github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-01-13 15:37:38 +00:00
Code Issues Projects Releases Wiki Activity

Further cleanup of comparison functions

Browse Source 
Mostly for cosmetics or convenience, a few glitches
This commit is contained in:
rmkaplan 2022-02-26 22:16:07 -08:00
parent ab8da79d30
commit d3b1c6a3b4
10 changed files with 336 additions and 243 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

294
lispusers/COMPAREDIRECTORIES
View File

@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "18-Feb-2022 17:05:27"  (FILECREATED "25-Feb-2022 21:30:55" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;189 119161 {DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;209 124231
:CHANGES-TO (FNS CD-MENUFN) :CHANGES-TO (FNS CDFILES)
:PREVIOUS-DATE "11-Feb-2022 16:21:21" :PREVIOUS-DATE "24-Feb-2022 21:13:32"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;188) {DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;208)
(* ; " (* ; "
@ -19,8 +19,9 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
( (
(* ;; "Compare the contents of two directories.") (* ;; "Compare the contents of two directories.")
(FNS COMPAREDIRECTORIES COMPAREDIRECTORIES.INFOS CDENTRIES.SELECT (FNS COMPAREDIRECTORIES COMPAREDIRECTORIES.INFOS COMPAREDIRECTORIES.CANDIDATES
COMPAREDIRECTORIES.INFOS.TYPE MATCHNAME CD.INSURECDVALUE CD.UPDATEWIDTHS) CDENTRIES.SELECT COMPAREDIRECTORIES.INFOS.TYPE MATCHNAME CD.INSURECDVALUE
CD.UPDATEWIDTHS)
(FNS CDFILES CDFILES.MATCH CDFILES.PATS) (FNS CDFILES CDFILES.MATCH CDFILES.PATS)
(FNS CDPRINT CDPRINT.HEADER CDPRINT.LINE CDPRINT.MAXWIDTHS CDPRINT.COLHEADERS CDPRINT.COLUMNS (FNS CDPRINT CDPRINT.HEADER CDPRINT.LINE CDPRINT.MAXWIDTHS CDPRINT.COLHEADERS CDPRINT.COLUMNS
CDTEDIT) CDTEDIT)
@ -65,7 +66,8 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
(COMPAREDIRECTORIES (COMPAREDIRECTORIES
[LAMBDA (DIR1 DIR2 SELECT INCLUDEDFILES EXCLUDEDFILES USEDIRECTORYDATE OUTPUTFILE ALLVERSIONS [LAMBDA (DIR1 DIR2 SELECT INCLUDEDFILES EXCLUDEDFILES USEDIRECTORYDATE OUTPUTFILE ALLVERSIONS
FIXDIRECTORYDATES) (* ; "Edited 4-Feb-2022 13:44 by rmk") FIXDIRECTORYDATES) (* ; "Edited 23-Feb-2022 21:10 by rmk")
(* ; "Edited 4-Feb-2022 13:44 by rmk")
(* ; "Edited 31-Jan-2022 21:52 by rmk") (* ; "Edited 31-Jan-2022 21:52 by rmk")
(* ; "Edited 26-Jan-2022 13:33 by rmk") (* ; "Edited 26-Jan-2022 13:33 by rmk")
(* ; "Edited 4-Jan-2022 12:09 by rmk") (* ; "Edited 4-Jan-2022 12:09 by rmk")
@ -97,7 +99,7 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
(*- '*-) (*- '*-)
(~= '~=) (~= '~=)
(ERROR "UNRECOGNIZED SELECT PARAMETER" S] (ERROR "UNRECOGNIZED SELECT PARAMETER" S]
(PROG (INFOS1 INFOS2 CANDIDATES CDENTRIES DEPTH1 DEPTH2 CDVALUE (DATE (DATE))) (PROG (INFOS1 INFOS2 CDENTRIES DEPTH1 DEPTH2 CDVALUE (DATE (DATE)))
(* ;; "DIRECTORYNAME here to get unrelativized specifications for header.") (* ;; "DIRECTORYNAME here to get unrelativized specifications for header.")
@ -121,10 +123,13 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
(PRINTOUT T " ... ") (PRINTOUT T " ... ")
(SETQ INFOS1 (COMPAREDIRECTORIES.INFOS (CDFILES DIR1 INCLUDEDFILES EXCLUDEDFILES (SETQ INFOS1 (COMPAREDIRECTORIES.INFOS (CDFILES DIR1 INCLUDEDFILES EXCLUDEDFILES
ALLVERSIONS DEPTH1) ALLVERSIONS DEPTH1)
USEDIRECTORYDATE DIR1)) USEDIRECTORYDATE DIR1 ALLVERSIONS))
(SETQ INFOS2 (COMPAREDIRECTORIES.INFOS (CDFILES DIR2 INCLUDEDFILES EXCLUDEDFILES (SETQ INFOS2 (COMPAREDIRECTORIES.INFOS (CDFILES DIR2 INCLUDEDFILES EXCLUDEDFILES
ALLVERSIONS DEPTH2) ALLVERSIONS DEPTH2)
USEDIRECTORYDATE DIR2)) USEDIRECTORYDATE DIR2 ALLVERSIONS))
(* ;; "The CAR of each info is the atomic match-name, the CDR is a list of infos with that matchname, only 1 unless AllVERSIONS. ")
(SETQ CDVALUE (CREATE CDVALUE (SETQ CDVALUE (CREATE CDVALUE
CDDIR1 _ DIR1 CDDIR1 _ DIR1
CDDIR2 _ DIR2 CDDIR2 _ DIR2
@ -133,40 +138,11 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
(CL:UNLESS (OR INFOS2 INFOS1) (CL:UNLESS (OR INFOS2 INFOS1)
(RETURN CDVALUE)) (RETURN CDVALUE))
(* ;; "At this point the CAR of each info is the atomic match-name. Peel it off to produce candidate entries.") (* ;; "Correlate the I1's and I2's with the same match name, then do the select filtering and insert the date relations")
(* ;; (SETQ CDENTRIES (SORT (CDENTRIES.SELECT (COMPAREDIRECTORIES.CANDIDATES INFOS1 INFOS2)
 "Look through all of the I2's because multiple versions (if VERSIONS) have the same matchname") SELECT)
[SETQ CANDIDATES (for I1 in INFOS1
join (if ALLVERSIONS
then (OR (for I2 in INFOS2 when (EQ (CAR I2)
(CAR I1))
collect (LIST (CAR I1)
(CDR I1)
(CDR I2)))
(CONS (LIST (CAR I1)
(CDR I1)
NIL)))
else (CONS (LIST (CAR I1)
(CDR I1)
(CDR (ASSOC (CAR I1)
INFOS2]
(* ;; "Could be some 2's without 1's")
(SETQ CANDIDATES (SORT [NCONC CANDIDATES (for I2 in INFOS2 unless (ASSOC (CAR I2)
CANDIDATES)
collect (LIST (CAR I2)
NIL
(CDR I2]
T)) T))
(* ;; "CANDIDATES is now a sorted list of the form (matchname entry1 entry2) where an entry consists of (fullname date length author)")
(* ;; "Do the SELECT filtering and insert the date relation.")
(SETQ CDENTRIES (CDENTRIES.SELECT CANDIDATES SELECT))
(PRINTOUT T (LENGTH CDENTRIES) (PRINTOUT T (LENGTH CDENTRIES)
" entries" T) " entries" T)
(REPLACE CDENTRIES OF CDVALUE WITH CDENTRIES) (REPLACE CDENTRIES OF CDVALUE WITH CDENTRIES)
@ -176,13 +152,11 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
(RETURN (CDPRINT CDVALUE OUTPUTFILE NIL (MEMB 'AUTHOR SELECT]) (RETURN (CDPRINT CDVALUE OUTPUTFILE NIL (MEMB 'AUTHOR SELECT])
(COMPAREDIRECTORIES.INFOS (COMPAREDIRECTORIES.INFOS
[LAMBDA (FILES USEDIRECTORYDATE DIR) (* ; "Edited 4-Jan-2022 15:23 by rmk") [LAMBDA (FILES USEDIRECTORYDATE DIR ALLVERSIONS)
(* ; "Edited 23-Dec-2021 18:59 by rmk")
(* ; "Edited 12-Dec-2021 22:50 by rmk")
(* ; "Edited 23-Nov-2021 12:27 by rmk:")
(* ; "Edited 13-Oct-2020 08:42 by rmk:")
(* ;; "Value is a list of CDINFOS with the match-name consed on to the front") (* ;; "Edited 24-Feb-2022 09:19 by rmk: is a list of CDINFOS with the match-name consed on to the front. If ALLVERSIONS")
(* ;; "Value is a list of the form (matchname . CDINFOS). CDINFOS is guaranteed to be a singleton, unless ALLVERSIONS. ")
(FOR FULLNAME TYPE LDATE STREAM (STARTPOS _ (ADD1 (NCHARS DIR))) IN FILES (FOR FULLNAME TYPE LDATE STREAM (STARTPOS _ (ADD1 (NCHARS DIR))) IN FILES
COLLECT COLLECT
@ -194,9 +168,9 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
 "So all the GETFILEINFO's, FILEDATES, etc. don't have to do the directory searching.")  "So all the GETFILEINFO's, FILEDATES, etc. don't have to do the directory searching.")
(SETQ LDATE (OR (FILEDATE STREAM T) (SETQ LDATE (OR (FILEDATE STREAM T)
(FILEDATE STREAM))) (FILEDATE STREAM)))
(PROG1 (CONS (MATCHNAME FULLNAME STARTPOS) (PROG1 (LIST (MATCHNAME FULLNAME STARTPOS)
(CREATE CDINFO (CREATE CDINFO
FULLNAME _ FULLNAME FULLNAME _ (FULLNAME STREAM)
DATE _ (GDATE (IDATE (IF (OR USEDIRECTORYDATE (NULL LDATE)) DATE _ (GDATE (IDATE (IF (OR USEDIRECTORYDATE (NULL LDATE))
THEN (GETFILEINFO STREAM 'CREATIONDATE) THEN (GETFILEINFO STREAM 'CREATIONDATE)
ELSE (SETFILEINFO STREAM 'CREATIONDATE LDATE) ELSE (SETFILEINFO STREAM 'CREATIONDATE LDATE)
@ -205,20 +179,86 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
AUTHOR _ (GETFILEINFO STREAM 'AUTHOR) AUTHOR _ (GETFILEINFO STREAM 'AUTHOR)
TYPE _ (COMPAREDIRECTORIES.INFOS.TYPE STREAM LDATE) TYPE _ (COMPAREDIRECTORIES.INFOS.TYPE STREAM LDATE)
EOL _ (EOLTYPE STREAM))) EOL _ (EOLTYPE STREAM)))
(CLOSEF? STREAM]) (CLOSEF? STREAM))
FINALLY
(* ;; "Sort to get all entries with the same matchname adjacent. Presumably we would only need to collect multiples if ALLVERSIONS, but in a case-sensitive file system we might see files with names that differ in case. We have deliberately given them a case-insensitive matchname, so we can expose this issue in the display.")
(* ;; "If we see (MN X)(MN Y), smash the Y in after the X")
(RETURN (FOR ITAIL I VAL MN ON (SORT $$VAL T)
DO (SETQ I (CAR ITAIL))
(SETQ MN (CAR I))
[WHILE (EQ MN (CAADR ITAIL)) DO (POP ITAIL)
(PUSH (CDR I)
(CADR (CAR ITAIL]
(PUSH VAL I) FINALLY (RETURN (DREVERSE VAL])
(COMPAREDIRECTORIES.CANDIDATES
[LAMBDA (INFOS1 INFOS2)
(* ;; "Edited 24-Feb-2022 10:00 by rmk: Correlate the I1's and I2's with the same match name. Rely on the fact that the lists are sorted.")
(SETQ INFOS1 (SORT INFOS1 T))
(SETQ INFOS2 (SORT INFOS2 T))
(LET (PAIRS)
(BIND I1 I2 (I1TAIL _ INFOS1)
(I2TAIL _ INFOS2) DO (IF (AND I1TAIL I2TAIL)
THEN (SETQ I1 (CAR I1TAIL))
(SETQ I2 (CAR I2TAIL))
(IF (EQ (CAR I1)
(CAR I2))
THEN (PUSH PAIRS (LIST (CAR I1)
(CDR I1)
(CDR I2)))
(POP I1TAIL)
(POP I2TAIL)
ELSEIF (ALPHORDER (CAR I1)
(CAR I2))
THEN (PUSH PAIRS (LIST (CAR I1)
(CDR I1)
(CONS NIL)))
(POP I1TAIL)
ELSE (PUSH PAIRS (LIST (CAR I2)
(CONS NIL)
(CDR I2)))
(POP I2TAIL))
ELSEIF I1TAIL
THEN [FOR I1 IN I1TAIL
DO (PUSH PAIRS (LIST (CAR I1)
(CDR I1)
(CONS NIL]
(RETURN)
ELSEIF I2TAIL
THEN [FOR I2 IN I2TAIL
DO (PUSH PAIRS (LIST (CAR I2)
(CONS NIL)
(CDR I2]
(RETURN)
ELSE (RETURN)))
(* ;; "Take the cross products (if ALLVERSIONS) to create a list of (MN I1 I2) CDENTRIES with singleton infos.")
(FOR P MN CANDIDATES IN PAIRS
DO (SETQ MN (CAR P))
[FOR I1 IN (CADR P)
DO (FOR I2 IN (CADDR P)
DO (PUSH CANDIDATES (CREATE CDENTRY
MATCHNAME _ MN
INFO1 _ I1
INFO2 _ I2] FINALLY (RETURN CANDIDATES])
(CDENTRIES.SELECT (CDENTRIES.SELECT
[LAMBDA (CANDIDATES SELECT) (* ; "Edited 4-Jan-2022 21:31 by rmk") [LAMBDA (CANDIDATES SELECT) (* ; "Edited 23-Feb-2022 20:45 by rmk")
(* ; "Edited 4-Jan-2022 21:31 by rmk")
(* ;; "Does the pairwise select filter and inserts the date relation") (* ;; "Does the pairwise select filter and inserts the date relation")
(for C MATCHNAME INFO1 INFO2 IDATE1 IDATE2 DATEREL BINCOMP [COMPAREDATE (for CDE MATCHNAME INFO1 INFO2 IDATE1 IDATE2 DATEREL BINCOMP
_ [COMPAREDATE _ (INTERSECTION SELECT '(< > =] in CANDIDATES
(INTERSECTION SELECT eachtime (SETQ MATCHNAME (FETCH (CDENTRY MATCHNAME) OF CDE))
'(< > =] in CANDIDATES (SETQ INFO1 (FETCH (CDENTRY INFO1) OF CDE))
eachtime (SETQ MATCHNAME (pop C)) (SETQ INFO2 (FETCH (CDENTRY INFO2) OF CDE))
(SETQ INFO1 (pop C))
(SETQ INFO2 (pop C))
(if (AND INFO1 INFO2) (if (AND INFO1 INFO2)
then (SETQ IDATE1 (IDATE (fetch DATE of INFO1))) then (SETQ IDATE1 (IDATE (fetch DATE of INFO1)))
(SETQ IDATE2 (IDATE (fetch DATE of INFO2))) (SETQ IDATE2 (IDATE (fetch DATE of INFO2)))
@ -275,14 +315,11 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
else else
(* ;; "OK if INFO1 is missing?") (* ;; "OK if INFO1 is missing?")
(MEMB '-* SELECT)) (MEMB '-* SELECT)) collect (REPLACE (CDENTRY DATEREL) OF CDE WITH DATEREL)
collect (create CDENTRY (REPLACE (CDENTRY EQUIV) OF CDE
MATCHNAME _ MATCHNAME WITH (CL:UNLESS (EQ DATEREL '*)
INFO1 _ INFO1 BINCOMP))
DATEREL _ DATEREL CDE])
INFO2 _ INFO2
EQUIV _ (CL:UNLESS (EQ DATEREL '*)
BINCOMP])
(COMPAREDIRECTORIES.INFOS.TYPE (COMPAREDIRECTORIES.INFOS.TYPE
[LAMBDA (FULLNAME LDATE) (* ; "Edited 4-Jan-2022 13:10 by rmk") [LAMBDA (FULLNAME LDATE) (* ; "Edited 4-Jan-2022 13:10 by rmk")
@ -299,19 +336,20 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
'OTHER]) 'OTHER])
(MATCHNAME (MATCHNAME
[LAMBDA (NAME STARTPOS) (* ; "Edited 23-Dec-2021 22:41 by rmk") [LAMBDA (NAME STARTPOS) (* ; "Edited 24-Feb-2022 09:10 by rmk")
(* ; "Edited 23-Dec-2021 22:41 by rmk")
(* ; "Edited 5-Sep-2020 13:41 by rmk:") (* ; "Edited 5-Sep-2020 13:41 by rmk:")
(* ;; "The NAME.DIR for matching related files") (* ;; "The canonical name for matching related files")
(LET [(M (PACKFILENAME 'VERSION NIL 'BODY (SUBATOM NAME STARTPOS] (LET [(M (UNSLASHIT (U-CASE (PACKFILENAME 'VERSION NIL 'BODY (SUBATOM NAME STARTPOS]
(* ;; "Strip off the nuisance period") (* ;; "Strip off the nuisance period")
(CL:IF (EQ (CHARCODE %.) (CL:IF (EQ (CHARCODE %.)
(NTHCHARCODE M -1)) (NTHCHARCODE M -1))
(SUBATOM M 1 -2) (SUBATOM M 1 -2)
M)]) (MKATOM M))])
(CD.INSURECDVALUE (CD.INSURECDVALUE
[LAMBDA (CDVALUE?) (* ; "Edited 30-Nov-2021 14:37 by rmk:") [LAMBDA (CDVALUE?) (* ; "Edited 30-Nov-2021 14:37 by rmk:")
@ -348,7 +386,8 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
(DEFINEQ (DEFINEQ
(CDFILES (CDFILES
[LAMBDA (DIR INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH)(* ; "Edited 26-Jan-2022 15:25 by rmk") [LAMBDA (DIR INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH)(* ; "Edited 25-Feb-2022 21:26 by rmk")
(* ; "Edited 26-Jan-2022 15:25 by rmk")
(* ; "Edited 21-Jan-2022 22:40 by rmk") (* ; "Edited 21-Jan-2022 22:40 by rmk")
(* ; "Edited 5-Jan-2022 15:07 by rmk") (* ; "Edited 5-Jan-2022 15:07 by rmk")
(* ; "Edited 23-Dec-2021 22:49 by rmk") (* ; "Edited 23-Dec-2021 22:49 by rmk")
@ -379,11 +418,10 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
(SETQ EXCLUDEDFILES (LDIFFERENCE EXCLUDEDFILES INCLUDEDFILES)) (SETQ EXCLUDEDFILES (LDIFFERENCE EXCLUDEDFILES INCLUDEDFILES))
(LET ([INCLUDES (CDFILES.PATS (OR INCLUDEDFILES '*.*] (LET ([INCLUDES (CDFILES.PATS (OR INCLUDEDFILES '*.*]
(EXCLUDES (AND EXCLUDEDFILES (CDFILES.PATS EXCLUDEDFILES))) (EXCLUDES (AND EXCLUDEDFILES (CDFILES.PATS EXCLUDEDFILES)))
(TOPDIR (DIRECTORYNAME (OR DIR T)))
HOST FILING.ENUMERATION.DEPTH ENUMPAT) HOST FILING.ENUMERATION.DEPTH ENUMPAT)
(DECLARE (SPECVARS FILING.ENUMERATION.DEPTH)) (DECLARE (SPECVARS FILING.ENUMERATION.DEPTH))
(SETQ HOST (FILENAMEFIELD TOPDIR 'HOST)) (SETQ HOST (FILENAMEFIELD DIR 'HOST))
(SETQ TOPDIR (FILENAMEFIELD TOPDIR 'DIRECTORY)) (SETQ DIR (FILENAMEFIELD DIR 'DIRECTORY))
[SETQ FILING.ENUMERATION.DEPTH (IF (EQ DEPTH T) [SETQ FILING.ENUMERATION.DEPTH (IF (EQ DEPTH T)
THEN MAX.SMALLP THEN MAX.SMALLP
ELSEIF DEPTH ELSEIF DEPTH
@ -411,8 +449,7 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
 "If We don't prefix TOPDIR with <, then if TOPDIR contains a colon it is interpreted as a device.")  "If We don't prefix TOPDIR with <, then if TOPDIR contains a colon it is interpreted as a device.")
(SETQ ENUMPAT (PACKFILENAME 'HOST HOST 'DIRECTORY (SETQ ENUMPAT (PACKFILENAME 'HOST HOST 'DIRECTORY
(CONCAT "<" TOPDIR ">" (CONCAT "<" DIR ">" (OR SD ""))
(OR SD ""))
'NAME N 'EXTENSION E 'VERSION 'NAME N 'EXTENSION E 'VERSION
(CL:IF ALLVERSIONS (CL:IF ALLVERSIONS
'* '*
@ -424,7 +461,7 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
(* ;; "We enumerate all the files, checking to see that") (* ;; "We enumerate all the files, checking to see that")
(FOR FULLNAME NAME EXT SUBDIR UNPACK THISDEPTH (STARTPOS _ (ADD1 (NCHARS TOPDIR))) (FOR FULLNAME NAME EXT SUBDIR UNPACK THISDEPTH (STARTPOS _ (ADD1 (NCHARS DIR)))
IN (DIRECTORY ENUMPAT NIL NIL (CL:IF ALLVERSIONS IN (DIRECTORY ENUMPAT NIL NIL (CL:IF ALLVERSIONS
"*" "*"
"")) ""))
@ -1651,8 +1688,9 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
BROWSER)]) BROWSER)])
(CDBROWSER.STRINGS (CDBROWSER.STRINGS
[LAMBDA (CDVALUE COLHEADINGS SEPARATEDIRECTIONS) (* ; "Edited 14-Dec-2021 21:03 by rmk") [LAMBDA (CDVALUE COLHEADINGS SEPARATEDIRECTIONS) (* ; "Edited 22-Feb-2022 18:30 by rmk")
(* ; "Edited 8-Dec-2021 11:22 by rmk") (* ; "Edited 14-Dec-2021 21:03 by rmk")
(* ; "Edited 8-Dec-2021 11:22 by rmk")
(* ; "Edited 27-Nov-2021 21:37 by rmk:") (* ; "Edited 27-Nov-2021 21:37 by rmk:")
(* ;; "Create a list of elements one for each CDENTRY of the form (printstring CDENTRY LATER)") (* ;; "Create a list of elements one for each CDENTRY of the form (printstring CDENTRY LATER)")
@ -1680,6 +1718,8 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
(IF (FETCH INFO1 OF CDENTRY) (IF (FETCH INFO1 OF CDENTRY)
THEN 'LEFT THEN 'LEFT
ELSE 'RIGHT)) ELSE 'RIGHT))
((R C) (* ; "Renamed or copied")
(FETCH DATEREL OF CDENTRY))
(SHOULDNT))) (SHOULDNT)))
(* ;; "Take off the EQUIV field. Should used COL1START") (* ;; "Take off the EQUIV field. Should used COL1START")
@ -1730,14 +1770,22 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
WINDOW]) WINDOW])
(CD.TABLEITEM.COPYFN (CD.TABLEITEM.COPYFN
[LAMBDA (CDBROWSER ITEM) (* ; "Edited 25-Dec-2021 12:58 by rmk") [LAMBDA (CDBROWSER ITEM) (* ; "Edited 24-Feb-2022 21:12 by rmk")
(LET [(CDENTRY (CADR (FETCH TIDATA OF ITEM] (* ; "Edited 25-Dec-2021 12:58 by rmk")
(SELECTQ [MENU (CREATE MENU (LET [LEFT RIGHT FILE (CDENTRY (CADR (FETCH TIDATA OF ITEM]
(SETQ LEFT (FETCH (CDINFO FULLNAME) OF (FETCH (CDENTRY INFO1) OF CDENTRY)))
(SETQ RIGHT (FETCH (CDINFO FULLNAME) OF (FETCH (CDENTRY INFO2) OF CDENTRY)))
(SETQ FILE (IF (AND LEFT RIGHT)
THEN (SELECTQ [MENU (CREATE MENU
TITLE _ "Which File?" TITLE _ "Which File?"
ITEMS _ '(Left Right] ITEMS _ '(Left Right]
(Left (COPYINSERT (FETCH (CDINFO FULLNAME) OF (FETCH (CDENTRY INFO1) OF CDENTRY)))) (Left LEFT)
(Right (COPYINSERT (FETCH (CDINFO FULLNAME) OF (FETCH (CDENTRY INFO2) OF CDENTRY)))) (Right RIGHT)
NIL]) NIL)
ELSE (OR LEFT RIGHT)))
(CL:WHEN FILE
(PUTCLIPBOARD FILE)
(COPYINSERT FILE))])
(CDTABLEBROWSER.HEADING.REPAINTFN (CDTABLEBROWSER.HEADING.REPAINTFN
[LAMBDA (WINDOW REGION) (* ; "Edited 28-Nov-2021 09:09 by rmk:") [LAMBDA (WINDOW REGION) (* ; "Edited 28-Nov-2021 09:09 by rmk:")
@ -1760,7 +1808,8 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
'DON'T]) 'DON'T])
(CD.COMMANDSELECTEDFN (CD.COMMANDSELECTEDFN
[LAMBDA (MENUITEM MENU KEY) (* ; "Edited 5-Feb-2022 17:23 by rmk") [LAMBDA (MENUITEM MENU KEY) (* ; "Edited 24-Feb-2022 19:52 by rmk")
(* ; "Edited 5-Feb-2022 17:23 by rmk")
(* ; "Edited 27-Jan-2022 17:46 by rmk") (* ; "Edited 27-Jan-2022 17:46 by rmk")
(* ; "Edited 10-Jan-2022 22:51 by rmk") (* ; "Edited 10-Jan-2022 22:51 by rmk")
(* ; "Edited 25-Dec-2021 11:20 by rmk") (* ; "Edited 25-Dec-2021 11:20 by rmk")
@ -1777,7 +1826,8 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
(CDBROWSER (WINDOWPROP WINDOW 'TABLEBROWSER)) (CDBROWSER (WINDOWPROP WINDOW 'TABLEBROWSER))
(USERDATA (TB.USERDATA CDBROWSER)) (USERDATA (TB.USERDATA CDBROWSER))
(CDVALUE (LISTGET USERDATA 'CDVALUE)) (CDVALUE (LISTGET USERDATA 'CDVALUE))
(FN (CADR (LISTP MENUITEM] (FN (CADR (LISTP MENUITEM)))
(MIDDLE (EQ KEY 'MIDDLE]
(DECLARE (SPECVARS WINDOW PWINDOW CDVALUE USERDATA)) (DECLARE (SPECVARS WINDOW PWINDOW CDVALUE USERDATA))
(GIVE.TTY.PROCESS PWINDOW) (GIVE.TTY.PROCESS PWINDOW)
(TTYDISPLAYSTREAM PWINDOW) (* ; "Pwindow") (TTYDISPLAYSTREAM PWINDOW) (* ; "Pwindow")
@ -1785,7 +1835,14 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
((EQ 0 (TB.NUMBER.OF.ITEMS CDBROWSER 'SELECTED)) ((EQ 0 (TB.NUMBER.OF.ITEMS CDBROWSER 'SELECTED))
(FLASHWINDOW PWINDOW) (FLASHWINDOW PWINDOW)
(PRIN3 "Please make a selection" T)) (PRIN3 "Please make a selection" T))
(T (TB.MAP.SELECTED.ITEMS (T (CL:WHEN MIDDLE
(GIVE.TTY.PROCESS PWINDOW)
(CLEARW PWINDOW)
(FLASHWINDOW PWINDOW)
(CL:UNLESS (EQ 'Y (ASKUSER NIL 'N "Apply to all selected items? "))
(SETQ KEY 'LEFT)
(PRIN3 " ... " PWINDOW)))
(TB.MAP.SELECTED.ITEMS
CDBROWSER CDBROWSER
[FUNCTION (LAMBDA (CDBROWSER TBITEM) [FUNCTION (LAMBDA (CDBROWSER TBITEM)
(LET* ((CDENTRY (CADR (FETCH TIDATA OF TBITEM))) (LET* ((CDENTRY (CADR (FETCH TIDATA OF TBITEM)))
@ -1804,16 +1861,29 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
FILE2))) FILE2)))
(DECLARE (SPECVARS . T)) (DECLARE (SPECVARS . T))
(* ;;
 "One of the files is not real if its date is %"%", a rename.")
(CL:WHEN (STREQUAL "" (FETCH (CDINFO DATE)
OF (FETCH (CDENTRY INFO1)
OF CDENTRY)))
(SETQ FILE1 NIL))
(CL:WHEN (STREQUAL "" (FETCH (CDINFO DATE)
OF (FETCH (CDENTRY INFO2)
OF CDENTRY)))
(SETQ FILE2 NIL))
(* ;; "If USERDATA contains a LABELFN, then it is applied to the files and the rest of the USERDATA to produce abbreviated labels for titles and headers.") (* ;; "If USERDATA contains a LABELFN, then it is applied to the files and the rest of the USERDATA to produce abbreviated labels for titles and headers.")
(CLEARW T) (CLEARW T)
(CL:FUNCALL FN TBITEM MENUITEM CDBROWSER KEY] (CL:FUNCALL FN TBITEM MENUITEM CDBROWSER KEY]
(FUNCTION NILL]))]) (FUNCTION NILL))
(CL:WHEN MIDDLE (PRIN3 " Done" PWINDOW]))])
(CD-MENUFN (CD-MENUFN
[LAMBDA (TBITEM MENUITEM CDBROWSER KEY) [LAMBDA (TBITEM MENUITEM CDBROWSER KEY)
(* ;; "Edited 18-Feb-2022 16:56 by rmk: FILELABELFN, if provided, can be used to calculate abbreviated labels for the file, for example, to strip off any long common prefixes.") (* ;; "Edited 23-Feb-2022 22:27 by rmk: FILELABELFN, if provided, can be used to calculate abbreviated labels for the file, for example, to strip off any long common prefixes.")
(* ;; "The FILELABELFN, if provided, can be used to calculate abbreviated labels for the file, for example, to strip off any long common prefixes.") (* ;; "The FILELABELFN, if provided, can be used to calculate abbreviated labels for the file, for example, to strip off any long common prefixes.")
@ -2036,24 +2106,24 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
(PUTPROPS COMPAREDIRECTORIES COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1994 1998 (PUTPROPS COMPAREDIRECTORIES COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1994 1998
2018 2020 2021)) 2018 2020 2021))
(DECLARE%: DONTCOPY (DECLARE%: DONTCOPY
(FILEMAP (NIL (2555 19321 (COMPAREDIRECTORIES 2565 . 9265) (COMPAREDIRECTORIES.INFOS 9267 . 11387) ( (FILEMAP (NIL (2597 22158 (COMPAREDIRECTORIES 2607 . 7834) (COMPAREDIRECTORIES.INFOS 7836 . 10598) (
CDENTRIES.SELECT 11389 . 16075) (COMPAREDIRECTORIES.INFOS.TYPE 16077 . 16705) (MATCHNAME 16707 . 17237 COMPAREDIRECTORIES.CANDIDATES 10600 . 13985) (CDENTRIES.SELECT 13987 . 18762) (
) (CD.INSURECDVALUE 17239 . 18853) (CD.UPDATEWIDTHS 18855 . 19319)) (19322 29594 (CDFILES 19332 . COMPAREDIRECTORIES.INFOS.TYPE 18764 . 19392) (MATCHNAME 19394 . 20074) (CD.INSURECDVALUE 20076 . 21690
25688) (CDFILES.MATCH 25690 . 27315) (CDFILES.PATS 27317 . 29592)) (29595 44680 (CDPRINT 29605 . 31950 ) (CD.UPDATEWIDTHS 21692 . 22156)) (22159 32408 (CDFILES 22169 . 28502) (CDFILES.MATCH 28504 . 30129)
) (CDPRINT.HEADER 31952 . 32849) (CDPRINT.LINE 32851 . 35407) (CDPRINT.MAXWIDTHS 35409 . 39524) ( (CDFILES.PATS 30131 . 32406)) (32409 47494 (CDPRINT 32419 . 34764) (CDPRINT.HEADER 34766 . 35663) (
CDPRINT.COLHEADERS 39526 . 40164) (CDPRINT.COLUMNS 40166 . 44045) (CDTEDIT 44047 . 44678)) (44681 CDPRINT.LINE 35665 . 38221) (CDPRINT.MAXWIDTHS 38223 . 42338) (CDPRINT.COLHEADERS 42340 . 42978) (
53050 (CDMAP 44691 . 46123) (CDENTRY 46125 . 46434) (CDSUBSET 46436 . 47875) (CDMERGE 47877 . 51731) ( CDPRINT.COLUMNS 42980 . 46859) (CDTEDIT 46861 . 47492)) (47495 55864 (CDMAP 47505 . 48937) (CDENTRY
CDMERGE.COMMON 51733 . 53048)) (53051 60589 (BINCOMP 53061 . 57350) (EOLTYPE 57352 . 59914) ( 48939 . 49248) (CDSUBSET 49250 . 50689) (CDMERGE 50691 . 54545) (CDMERGE.COMMON 54547 . 55862)) (55865
EOLTYPE.SHOW 59916 . 60587)) (61117 74324 (FIND-UNCOMPILED-FILES 61127 . 64770) (FIND-UNSOURCED-FILES 63403 (BINCOMP 55875 . 60164) (EOLTYPE 60166 . 62728) (EOLTYPE.SHOW 62730 . 63401)) (63931 77138 (
64772 . 67581) (FIND-SOURCE-FILES 67583 . 69287) (FIND-COMPILED-FILES 69289 . 71367) ( FIND-UNCOMPILED-FILES 63941 . 67584) (FIND-UNSOURCED-FILES 67586 . 70395) (FIND-SOURCE-FILES 70397 .
FIND-UNLOADED-FILES 71369 . 72113) (FIND-LOADED-FILES 72115 . 72669) (FIND-MULTICOMPILED-FILES 72671 72101) (FIND-COMPILED-FILES 72103 . 74181) (FIND-UNLOADED-FILES 74183 . 74927) (FIND-LOADED-FILES
. 74322)) (74325 82527 (CREATED-AS 74335 . 79132) (SOURCE-FOR-COMPILED-P 79134 . 81832) ( 74929 . 75483) (FIND-MULTICOMPILED-FILES 75485 . 77136)) (77139 85341 (CREATED-AS 77149 . 81946) (
COMPILE-SOURCE-DATE-DIFF 81834 . 82525)) (82528 92834 (FIX-DIRECTORY-DATES 82538 . 85531) ( SOURCE-FOR-COMPILED-P 81948 . 84646) (COMPILE-SOURCE-DATE-DIFF 84648 . 85339)) (85342 95648 (
FIX-EQUIV-DATES 85533 . 87058) (COPY-COMPARED-FILES 87060 . 88881) (COPY-MISSING-FILES 88883 . 91040) FIX-DIRECTORY-DATES 85352 . 88345) (FIX-EQUIV-DATES 88347 . 89872) (COPY-COMPARED-FILES 89874 . 91695)
(COMPILED-ON-SAME-SOURCE 91042 . 92832)) (93028 100070 (CDBROWSER 93038 . 96965) (CDBROWSER.STRINGS (COPY-MISSING-FILES 91697 . 93854) (COMPILED-ON-SAME-SOURCE 93856 . 95646)) (95842 103188 (CDBROWSER
96967 . 100068)) (100232 101504 (CD.TABLEITEM 100242 . 100462) (CD.TABLEITEM.PRINTFN 100464 . 100663) 95852 . 99779) (CDBROWSER.STRINGS 99781 . 103186)) (103350 105086 (CD.TABLEITEM 103360 . 103580) (
(CD.TABLEITEM.COPYFN 100665 . 101259) (CDTABLEBROWSER.HEADING.REPAINTFN 101261 . 101502)) (101505 CD.TABLEITEM.PRINTFN 103582 . 103781) (CD.TABLEITEM.COPYFN 103783 . 104841) (
118577 (CDTABLEBROWSER.WHENSELECTEDFN 101515 . 101983) (CD.COMMANDSELECTEDFN 101985 . 105485) ( CDTABLEBROWSER.HEADING.REPAINTFN 104843 . 105084)) (105087 123647 (CDTABLEBROWSER.WHENSELECTEDFN
CD-MENUFN 105487 . 111662) (CDBROWSER-COPY 111664 . 115035) (CDBROWSER-DELETE-FILE 115037 . 118056) ( 105097 . 105565) (CD.COMMANDSELECTEDFN 105567 . 110555) (CD-MENUFN 110557 . 116732) (CDBROWSER-COPY
CD-SWAPDIRS 118058 . 118575))))) 116734 . 120105) (CDBROWSER-DELETE-FILE 120107 . 123126) (CD-SWAPDIRS 123128 . 123645)))))
STOP STOP

BIN
lispusers/COMPAREDIRECTORIES.LCOM
View File

Binary file not shown.

147
lispusers/COMPARESOURCES
View File

@ -1,12 +1,13 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "28-Jan-2022 18:22:40"  (FILECREATED "25-Feb-2022 18:02:24" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>COMPARESOURCES.;118 41270 {DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>COMPARESOURCES.;121 41359
:CHANGES-TO (FNS CSOBJ.BUTTONEVENTINFN) :CHANGES-TO (FNS \CS.COMPARE.MASTERS \CS.COMPARE.TYPES \CS.REC.NAME \CS.ISRECFORM)
(VARS COMPARESOURCETYPES COMPARESOURCESCOMS)
:PREVIOUS-DATE "28-Jan-2022 17:12:39" :PREVIOUS-DATE "28-Jan-2022 18:22:40"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>COMPARESOURCES.;116) {DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>COMPARESOURCES.;118)
(* ; " (* ; "
@ -19,9 +20,9 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
((FNS COMPARESOURCES \CS.COMPARE.MASTERS \CS.COMPARE.TYPES \CS.EXAMINE \CS.FIXFNS ((FNS COMPARESOURCES \CS.COMPARE.MASTERS \CS.COMPARE.TYPES \CS.EXAMINE \CS.FIXFNS
\CS.SORT.DECLARES \CS.SORT.DECLARE1 \CS.FILTER.GARBAGE) \CS.SORT.DECLARES \CS.SORT.DECLARE1 \CS.FILTER.GARBAGE)
(FNS \CS.ISFNFORM \CS.COMPARE.FNS \CS.FNSID \CS.ISVARFORM \CS.COMPARE.VARS \CS.ISMACROFORM (FNS \CS.ISFNFORM \CS.COMPARE.FNS \CS.FNSID \CS.ISVARFORM \CS.COMPARE.VARS \CS.ISMACROFORM
\CS.ISRECFORM \CS.ISCOURIERFORM \CS.ISTEMPLATEFORM \CS.COMPARE.TEMPLATES \CS.ISPROPFORM \CS.ISRECFORM \CS.REC.NAME \CS.ISCOURIERFORM \CS.ISTEMPLATEFORM \CS.COMPARE.TEMPLATES
\CS.PROP.NAME \CS.COMPARE.PROPS \CS.ISADDVARFORM \CS.COMPARE.ADDVARS \CS.ISFPKGCOMFORM \CS.ISPROPFORM \CS.PROP.NAME \CS.COMPARE.PROPS \CS.ISADDVARFORM \CS.COMPARE.ADDVARS
\CS.COMPARE.FPKGCOMS \CS.COMPARE.DEFINE-FILE-INFO) \CS.ISFPKGCOMFORM \CS.COMPARE.FPKGCOMS \CS.COMPARE.DEFINE-FILE-INFO)
[COMS (FNS CSOBJ.CREATE CSOBJ.DISPLAYFN CSOBJ.IMAGEBOXFN CSOBJ.BUTTONEVENTINFN [COMS (FNS CSOBJ.CREATE CSOBJ.DISPLAYFN CSOBJ.IMAGEBOXFN CSOBJ.BUTTONEVENTINFN
CSOBJ.COPYBUTTONEVENTINFN) CSOBJ.COPYBUTTONEVENTINFN)
(INITVARS (COMPARESOURCES-IMAGEFNS (IMAGEFNSCREATE 'CSOBJ.DISPLAYFN 'CSOBJ.IMAGEBOXFN (INITVARS (COMPARESOURCES-IMAGEFNS (IMAGEFNSCREATE 'CSOBJ.DISPLAYFN 'CSOBJ.IMAGEBOXFN
@ -138,9 +139,10 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
'SAME]) 'SAME])
(\CS.COMPARE.MASTERS (\CS.COMPARE.MASTERS
[LAMBDA (BODYX BODYY DW?) (* ; "Edited 18-Jan-2022 22:00 by rmk") [LAMBDA (BODYX BODYY DW?) (* ; "Edited 25-Feb-2022 18:02 by rmk")
(* ; "Edited 19-Dec-2021 21:05 by rmk") (* ; "Edited 18-Jan-2022 22:00 by rmk")
(* ; "Edited 5-Sep-2020 19:01 by rmk:") (* ; "Edited 19-Dec-2021 21:05 by rmk")
(* ; "Edited 5-Sep-2020 19:01 by rmk:")
(* ; "Edited 15-Apr-88 14:41 by bvm") (* ; "Edited 15-Apr-88 14:41 by bvm")
(DECLARE (USEDFREE DIFFERENCES COMPARESTREAM)) (DECLARE (USEDFREE DIFFERENCES COMPARESTREAM))
(LET (YTHING XTHING PRED DIFS TMP) (LET (YTHING XTHING PRED DIFS TMP)
@ -164,58 +166,49 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
do do
(* ;; "handle definer based things") (* ;; "handle definer based things")
(for DEFFER in DEFFERS do (SETQ XTHING (for X in BODYX collect X (for DEFFER in DEFFERS WHEN [AND (SETQ XTHING (for X in BODYX collect X
when (EQ (CAR X) when (EQ (CAR X)
DEFFER))) DEFFER)))
(SETQ YTHING (for X in BODYY collect X (SETQ YTHING (for X in BODYY collect X
when (EQ (CAR X) when (EQ (CAR X)
DEFFER))) DEFFER]
do
(* ;; "Take out all of the THINGS we are about to do. ") (* ;; "Take out all of the THINGS we are about to do. ")
(SETQ BODYX (CL:SET-DIFFERENCE BODYX XTHING :TEST (SETQ BODYX (CL:SET-DIFFERENCE BODYX XTHING :TEST (FUNCTION EQUALALL)))
(FUNCTION EQUALALL))) (SETQ BODYY (CL:SET-DIFFERENCE BODYY YTHING :TEST (FUNCTION EQUALALL)))
(SETQ BODYY (CL:SET-DIFFERENCE BODYY YTHING :TEST (CL:WHEN (SETQ DIFS (\CS.COMPARE.TYPES XTHING YTHING
(FUNCTION EQUALALL))) (CONCAT (OR (CL:DOCUMENTATION TYPE 'DEFINE-TYPES)
(COND
((SETQ DIFS (\CS.COMPARE.TYPES
XTHING YTHING
(CONCAT (OR (CL:DOCUMENTATION TYPE
'DEFINE-TYPES)
TYPE) TYPE)
" defined by " DEFFER) " defined by " DEFFER)
NIL NIL
(GET DEFFER :DEFINITION-NAME))) (GET DEFFER :DEFINITION-NAME)
(COND TYPE))
[COND
((SETQ TMP (ASSOC TYPE DIFFERENCES)) ((SETQ TMP (ASSOC TYPE DIFFERENCES))
(NCONC TMP DIFS)) (NCONC TMP DIFS))
(T (push DIFFERENCES (CONS TYPE DIFS] (T (push DIFFERENCES (CONS TYPE DIFS])]
(* ;; "These are for other filepkage types, as registered in COMPARESOURCETYPES") (* ;; "These are for other filepkage types, as registered in COMPARESOURCETYPES")
[for TYPE in COMPARESOURCETYPES do (SETQ PRED (fetch (CSTYPE PREDFN) of TYPE)) [for TYPE in COMPARESOURCETYPES EACHTIME (SETQ PRED (fetch (CSTYPE PREDFN) of TYPE))
(SETQ XTHING (for X in BODYX collect X WHEN [AND (SETQ XTHING (for X in BODYX collect X when (CL:FUNCALL PRED X)))
when (CL:FUNCALL PRED X))) (SETQ YTHING (for X in BODYY collect X when (CL:FUNCALL PRED X]
(SETQ YTHING (for X in BODYY collect X do (SETQ BODYX (CL:SET-DIFFERENCE BODYX XTHING :TEST (FUNCTION EQUALALL)))
when (CL:FUNCALL PRED X))) (SETQ BODYY (CL:SET-DIFFERENCE BODYY YTHING :TEST (FUNCTION EQUALALL)))
(SETQ BODYX (CL:SET-DIFFERENCE BODYX XTHING :TEST (CL:WHEN [SETQ DIFS (\CS.COMPARE.TYPES XTHING YTHING (OR (fetch (CSTYPE TITLE)
(FUNCTION EQUALALL))) of TYPE)
(SETQ BODYY (CL:SET-DIFFERENCE BODYY YTHING :TEST (MKSTRING (fetch (CSTYPE
(FUNCTION EQUALALL))) FPKGTYPE)
(COND
([SETQ DIFS (\CS.COMPARE.TYPES
XTHING YTHING
(OR (fetch (CSTYPE TITLE) of TYPE)
(MKSTRING (fetch (CSTYPE FPKGTYPE)
of TYPE))) of TYPE)))
(fetch (CSTYPE COMPAREFN) of TYPE) (fetch (CSTYPE COMPAREFN) of TYPE)
(OR (fetch (CSTYPE IDFN) of TYPE) (OR (fetch (CSTYPE IDFN) of TYPE)
(FUNCTION CADR] (FUNCTION CADR))
(SETQ TYPE (fetch (CSTYPE FPKGTYPE) of TYPE)) (SETQ TYPE (fetch (CSTYPE FPKGTYPE) of TYPE]
(COND [COND
((SETQ TMP (ASSOC TYPE DIFFERENCES)) ((SETQ TMP (ASSOC TYPE DIFFERENCES))
(NCONC TMP DIFS)) (NCONC TMP DIFS))
(T (push DIFFERENCES (CONS TYPE DIFS] (T (push DIFFERENCES (CONS TYPE DIFS])]
(SETQ BODYY (CL:SET-DIFFERENCE BODYY (PROG1 BODYX (SETQ BODYY (CL:SET-DIFFERENCE BODYY (PROG1 BODYX
(SETQ BODYX (CL:SET-DIFFERENCE (SETQ BODYX (CL:SET-DIFFERENCE
BODYX BODYY :TEST BODYX BODYY :TEST
@ -245,22 +238,23 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
[COND [COND
[BODYX (COND [BODYX (COND
(BODYY (COMPARELISTS BODYX BODYY COMPARESTREAM) (BODYY (COMPARELISTS BODYX BODYY COMPARESTREAM)
(\CS.EXAMINE BODYX BODYY)) (\CS.EXAMINE BODYX BODYY NIL 'Expression))
(T (printout COMPARESTREAM "These are not on File 2:" T) (T (printout COMPARESTREAM "These are not on File 2:" T)
(FOR X IN BODYX DO (LVLPRINT X COMPARESTREAM 2 3) (FOR X IN BODYX DO (LVLPRINT X COMPARESTREAM 2 3)
(\CS.EXAMINE X NIL T] (\CS.EXAMINE X NIL T NIL 'Expression]
(BODYY (printout COMPARESTREAM "These are not on File 1:" T) (BODYY (printout COMPARESTREAM "These are not on File 1:" T)
(FOR Y IN BODYY DO (LVLPRINT Y COMPARESTREAM 2 3) (FOR Y IN BODYY DO (LVLPRINT Y COMPARESTREAM 2 3)
(\CS.EXAMINE NIL Y T] (\CS.EXAMINE NIL Y T NIL 'Expression]
(OR (ASSOC 'Other DIFFERENCES) (OR (ASSOC 'Other DIFFERENCES)
(push DIFFERENCES (LIST 'Other '--]) (push DIFFERENCES (LIST 'Other '--])
(\CS.COMPARE.TYPES (\CS.COMPARE.TYPES
[LAMBDA (XTHING YTHING TITLE COMPAREFN IDFN) (* ; "Edited 9-Dec-2021 23:19 by rmk") [LAMBDA (XTHING YTHING TITLE COMPAREFN IDFN TYPE) (* ; "Edited 25-Feb-2022 17:49 by rmk")
(* ; "Edited 1-Dec-2021 23:25 by rmk:") (* ; "Edited 9-Dec-2021 23:19 by rmk")
(* ; "Edited 30-Nov-2021 23:07 by rmk:") (* ; "Edited 1-Dec-2021 23:25 by rmk:")
(* ; "Edited 27-Nov-2021 12:32 by rmk:") (* ; "Edited 30-Nov-2021 23:07 by rmk:")
(* ; "Edited 25-Nov-2021 13:29 by rmk:") (* ; "Edited 27-Nov-2021 12:32 by rmk:")
(* ; "Edited 25-Nov-2021 13:29 by rmk:")
(* ; "Edited 29-Dec-86 11:49 by jds") (* ; "Edited 29-Dec-86 11:49 by jds")
(* ;;; "Compare things using COMPAREFN. Deltas -> COMPARESTREAM. Anything that passes the WHEN predicate has a difference somewhere, will produce some output. ") (* ;;; "Compare things using COMPAREFN. Deltas -> COMPARESTREAM. Anything that passes the WHEN predicate has a difference somewhere, will produce some output. ")
@ -276,7 +270,6 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
:TEST :TEST
(FUNCTION EQUALALL))) (FUNCTION EQUALALL)))
(OR XTHING YTHING))) (OR XTHING YTHING)))
DF
(* ;; "We know we are going to have some output. Strings can go directly onto theCONTEXTSTREAM, and objects may then be inserted.") (* ;; "We know we are going to have some output. Strings can go directly onto theCONTEXTSTREAM, and objects may then be inserted.")
@ -288,12 +281,12 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
NAME] NAME]
(printout COMPARESTREAM .FONT BOLDFONT .P2 NAME .FONT DEFAULTFONT (printout COMPARESTREAM .FONT BOLDFONT .P2 NAME .FONT DEFAULTFONT
" is not on File 2" T T) " is not on File 2" T T)
(\CS.EXAMINE X NIL T NAME)) (\CS.EXAMINE X NIL T NAME TYPE))
(T (printout COMPARESTREAM .FONT BOLDFONT .P2 NAME ":" .FONT DEFAULTFONT T) (T (printout COMPARESTREAM .FONT BOLDFONT .P2 NAME ":" .FONT DEFAULTFONT T)
(COND (COND
(COMPAREFN (CL:FUNCALL COMPAREFN X Y COMPARESTREAM)) (COMPAREFN (CL:FUNCALL COMPAREFN X Y COMPARESTREAM))
(T (COMPARELISTS X Y COMPARESTREAM))) (T (COMPARELISTS X Y COMPARESTREAM)))
(\CS.EXAMINE X Y NIL NAME) (\CS.EXAMINE X Y NIL NAME TYPE)
(RPLACA (FMEMB Y YTHING] (RPLACA (FMEMB Y YTHING]
(RPLACA TAIL) (RPLACA TAIL)
(push RESULT NAME)) (push RESULT NAME))
@ -301,7 +294,7 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
do (SETQ NAME (CL:FUNCALL IDFN Y)) do (SETQ NAME (CL:FUNCALL IDFN Y))
(printout COMPARESTREAM .FONT BOLDFONT .P2 NAME .FONT DEFAULTFONT (printout COMPARESTREAM .FONT BOLDFONT .P2 NAME .FONT DEFAULTFONT
" is not on File 1" T T) " is not on File 1" T T)
(\CS.EXAMINE Y NIL T NAME) (\CS.EXAMINE Y NIL T NAME TYPE)
(push RESULT NAME)) (push RESULT NAME))
RESULT)]) RESULT)])
@ -436,7 +429,21 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
) )
(\CS.ISRECFORM (\CS.ISRECFORM
(LAMBDA (X) (* bvm%: "25-Sep-85 12:20") (FMEMB (CAR X) CLISPRECORDTYPES))) [LAMBDA (X) (* ; "Edited 25-Feb-2022 15:17 by rmk")
(* bvm%: "25-Sep-85 12:20")
(OR (FMEMB (CAR X)
CLISPRECORDTYPES)
(EQ (CAR X)
'/DECLAREDATATYPE])
(\CS.REC.NAME
[LAMBDA (FORM) (* ; "Edited 25-Feb-2022 15:24 by rmk")
(IF (AND (EQ (CAR FORM)
'/DECLAREDATATYPE)
(EQ (CAR (CADR FORM))
'QUOTE))
THEN (CADR (CADR FORM))
ELSE (CADR FORM])
(\CS.ISCOURIERFORM (\CS.ISCOURIERFORM
(LAMBDA (X) (* bvm%: "13-Mar-86 16:21") (EQ (CAR X) (QUOTE COURIERPROGRAM)))) (LAMBDA (X) (* bvm%: "13-Mar-86 16:21") (EQ (CAR X) (QUOTE COURIERPROGRAM))))
@ -611,7 +618,7 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
((FNS \CS.ISFNFORM \CS.COMPARE.FNS \CS.FNSID "FNS defined by DEFINEQ") ((FNS \CS.ISFNFORM \CS.COMPARE.FNS \CS.FNSID "FNS defined by DEFINEQ")
(VARS \CS.ISVARFORM \CS.COMPARE.VARS) (VARS \CS.ISVARFORM \CS.COMPARE.VARS)
(MACROS \CS.ISMACROFORM) (MACROS \CS.ISMACROFORM)
(RECORDS \CS.ISRECFORM) (RECORDS \CS.ISRECFORM NIL \CS.REC.NAME)
(PROPS \CS.ISPROPFORM \CS.COMPARE.PROPS \CS.PROP.NAME "Properties") (PROPS \CS.ISPROPFORM \CS.COMPARE.PROPS \CS.PROP.NAME "Properties")
(ADDVARS \CS.ISADDVARFORM \CS.COMPARE.ADDVARS CADR "Additions to lists") (ADDVARS \CS.ISADDVARFORM \CS.COMPARE.ADDVARS CADR "Additions to lists")
(TEMPLATES \CS.ISTEMPLATEFORM \CS.COMPARE.TEMPLATES CADADR) (TEMPLATES \CS.ISTEMPLATEFORM \CS.COMPARE.TEMPLATES CADADR)
@ -686,16 +693,16 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
) )
(PUTPROPS COMPARESOURCES COPYRIGHT ("Xerox Corporation" 1985 1986 1987 1988 2018 2020 2021)) (PUTPROPS COMPARESOURCES COPYRIGHT ("Xerox Corporation" 1985 1986 1987 1988 2018 2020 2021))
(DECLARE%: DONTCOPY (DECLARE%: DONTCOPY
(FILEMAP (NIL (1850 27174 (COMPARESOURCES 1860 . 7906) (\CS.COMPARE.MASTERS 7908 . 16052) ( (FILEMAP (NIL (1970 26690 (COMPARESOURCES 1980 . 8026) (\CS.COMPARE.MASTERS 8028 . 15440) (
\CS.COMPARE.TYPES 16054 . 19192) (\CS.EXAMINE 19194 . 23421) (\CS.FIXFNS 23423 . 24925) ( \CS.COMPARE.TYPES 15442 . 18708) (\CS.EXAMINE 18710 . 22937) (\CS.FIXFNS 22939 . 24441) (
\CS.SORT.DECLARES 24927 . 25270) (\CS.SORT.DECLARE1 25272 . 26692) (\CS.FILTER.GARBAGE 26694 . 27172)) \CS.SORT.DECLARES 24443 . 24786) (\CS.SORT.DECLARE1 24788 . 26208) (\CS.FILTER.GARBAGE 26210 . 26688))
(27175 31155 (\CS.ISFNFORM 27185 . 27453) (\CS.COMPARE.FNS 27455 . 27697) (\CS.FNSID 27699 . 27843) ( (26691 31227 (\CS.ISFNFORM 26701 . 26969) (\CS.COMPARE.FNS 26971 . 27213) (\CS.FNSID 27215 . 27359) (
\CS.ISVARFORM 27845 . 27950) (\CS.COMPARE.VARS 27952 . 28614) (\CS.ISMACROFORM 28616 . 28754) ( \CS.ISVARFORM 27361 . 27466) (\CS.COMPARE.VARS 27468 . 28130) (\CS.ISMACROFORM 28132 . 28270) (
\CS.ISRECFORM 28756 . 28849) (\CS.ISCOURIERFORM 28851 . 28951) (\CS.ISTEMPLATEFORM 28953 . 29051) ( \CS.ISRECFORM 28272 . 28600) (\CS.REC.NAME 28602 . 28921) (\CS.ISCOURIERFORM 28923 . 29023) (
\CS.COMPARE.TEMPLATES 29053 . 29418) (\CS.ISPROPFORM 29420 . 29575) (\CS.PROP.NAME 29577 . 29722) ( \CS.ISTEMPLATEFORM 29025 . 29123) (\CS.COMPARE.TEMPLATES 29125 . 29490) (\CS.ISPROPFORM 29492 . 29647)
\CS.COMPARE.PROPS 29724 . 29881) (\CS.ISADDVARFORM 29883 . 29976) (\CS.COMPARE.ADDVARS 29978 . 30143) (\CS.PROP.NAME 29649 . 29794) (\CS.COMPARE.PROPS 29796 . 29953) (\CS.ISADDVARFORM 29955 . 30048) (
(\CS.ISFPKGCOMFORM 30145 . 30352) (\CS.COMPARE.FPKGCOMS 30354 . 30561) (\CS.COMPARE.DEFINE-FILE-INFO \CS.COMPARE.ADDVARS 30050 . 30215) (\CS.ISFPKGCOMFORM 30217 . 30424) (\CS.COMPARE.FPKGCOMS 30426 .
30563 . 31153)) (31156 37220 (CSOBJ.CREATE 31166 . 31579) (CSOBJ.DISPLAYFN 31581 . 32334) ( 30633) (\CS.COMPARE.DEFINE-FILE-INFO 30635 . 31225)) (31228 37292 (CSOBJ.CREATE 31238 . 31651) (
CSOBJ.IMAGEBOXFN 32336 . 34497) (CSOBJ.BUTTONEVENTINFN 34499 . 36970) (CSOBJ.COPYBUTTONEVENTINFN 36972 CSOBJ.DISPLAYFN 31653 . 32406) (CSOBJ.IMAGEBOXFN 32408 . 34569) (CSOBJ.BUTTONEVENTINFN 34571 . 37042)
. 37218)) (38084 40788 (CSBROWSER 38094 . 40786))))) (CSOBJ.COPYBUTTONEVENTINFN 37044 . 37290)) (38173 40877 (CSBROWSER 38183 . 40875)))))
STOP STOP

BIN
lispusers/COMPARESOURCES.LCOM
View File

Binary file not shown.

BIN
lispusers/COMPARETEXT.LCOM
View File

Binary file not shown.

25
lispusers/EXAMINEDEFS
View File

@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 1-Feb-2022 23:15:24"  (FILECREATED "25-Feb-2022 18:04:08" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>EXAMINEDEFS.;36 11920 {DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>EXAMINEDEFS.;37 12345
:CHANGES-TO (FNS EXAMINEFILES) :CHANGES-TO (FNS EXAMINEDEFS)
:PREVIOUS-DATE " 1-Feb-2022 15:43:17" :PREVIOUS-DATE " 1-Feb-2022 23:15:24"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>EXAMINEDEFS.;35) {DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>EXAMINEDEFS.;36)
(PRETTYCOMPRINT EXAMINEDEFSCOMS) (PRETTYCOMPRINT EXAMINEDEFSCOMS)
@ -19,7 +19,8 @@
(DEFINEQ (DEFINEQ
(EXAMINEDEFS (EXAMINEDEFS
[LAMBDA (NAME TYPE SOURCE1 SOURCE2 TITLE1 TITLE2 REGION) (* ; "Edited 1-Feb-2022 15:42 by rmk") [LAMBDA (NAME TYPE SOURCE1 SOURCE2 TITLE1 TITLE2 REGION) (* ; "Edited 25-Feb-2022 15:01 by rmk")
(* ; "Edited 1-Feb-2022 15:42 by rmk")
(* ; "Edited 23-Jan-2022 17:40 by rmk") (* ; "Edited 23-Jan-2022 17:40 by rmk")
(* ; "Edited 18-Jan-2022 22:40 by rmk") (* ; "Edited 18-Jan-2022 22:40 by rmk")
(* ; "Edited 12-Jan-2022 17:29 by rmk") (* ; "Edited 12-Jan-2022 17:29 by rmk")
@ -55,9 +56,15 @@
ELSEIF (GETDEF NAME TYPE SOURCE2) ELSEIF (GETDEF NAME TYPE SOURCE2)
ELSE (ERROR NAME " not found on " SOURCE2))) ELSE (ERROR NAME " not found on " SOURCE2)))
(CL:UNLESS TITLE1 (CL:UNLESS TITLE1
(SETQ TITLE1 (OR SOURCE1 "File 1"))) (SETQ TITLE1 (CL:IF (AND SOURCE1 (ILEQ (COUNT SOURCE1)
5))
SOURCE1
"File 1")))
(CL:UNLESS TITLE2 (CL:UNLESS TITLE2
(SETQ TITLE2 (OR SOURCE2 "File 2"))) (SETQ TITLE2 (CL:IF (AND SOURCE2 (ILEQ (COUNT SOURCE2)
5))
SOURCE12
"File 2")))
(SELECTQ (EDITMODE) (SELECTQ (EDITMODE)
(SEDIT:SEDIT (SEDIT:SEDIT
(* ;; (* ;;
@ -199,6 +206,6 @@
(FILESLOAD (SYSLOAD) (FILESLOAD (SYSLOAD)
COMPARETEXT) COMPARETEXT)
(DECLARE%: DONTCOPY (DECLARE%: DONTCOPY
(FILEMAP (NIL (662 11778 (EXAMINEDEFS 672 . 8792) (EXAMINEFILES 8794 . 10189) (TEDITDEF 10191 . 11776) (FILEMAP (NIL (661 12203 (EXAMINEDEFS 671 . 9217) (EXAMINEFILES 9219 . 10614) (TEDITDEF 10616 . 12201)
)))) ))))
STOP STOP

BIN
lispusers/EXAMINEDEFS.LCOM
View File

Binary file not shown.

40
lispusers/PSEUDOHOSTS
View File

@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 5-Feb-2022 08:23:53"  (FILECREATED "24-Feb-2022 23:56:08" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>PSEUDOHOSTS.;136 25474 {DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>PSEUDOHOSTS.;138 25865
:CHANGES-TO (FNS EXPAND.PH) :CHANGES-TO (FNS PSEUDOHOST PSEUDOHOSTP)
:PREVIOUS-DATE "30-Jan-2022 08:58:48" :PREVIOUS-DATE " 5-Feb-2022 08:23:53"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>PSEUDOHOSTS.;135) {DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>PSEUDOHOSTS.;136)
(PRETTYCOMPRINT PSEUDOHOSTSCOMS) (PRETTYCOMPRINT PSEUDOHOSTSCOMS)
@ -38,12 +38,18 @@
(PSEUDOHOST (PSEUDOHOST
[LAMBDA (HOST PREFIX) [LAMBDA (HOST PREFIX)
(* ;; "Edited 30-Jan-2022 08:58 by rmk: Expand prefix so that it is rooted in a real host and not a previously defined pseudohost.") (* ;; "Edited 24-Feb-2022 23:56 by rmk: Expand prefix so that it is rooted in a real host and not a previously defined pseudohost.")
(CL:WHEN (AND (LISTP HOST) (CL:WHEN (AND (LISTP HOST)
(NULL PREFIX)) (NULL PREFIX))
(SETQ PREFIX (CADR HOST)) (SETQ PREFIX (CADR HOST))
(SETQ HOST (CAR HOST))) (SETQ HOST (CAR HOST)))
(CL:WHEN (EQ (CHCON1 HOST)
(CHARCODE {))
(SETQ HOST (SUBSTRING HOST 2)))
(CL:WHEN (EQ (NTHCHARCODE HOST -1)
(CHARCODE }))
(SETQ HOST (SUBSTRING HOST 1 -2)))
(SETQ HOST (U-CASE (MKATOM HOST))) (SETQ HOST (U-CASE (MKATOM HOST)))
[IF PREFIX [IF PREFIX
THEN (CL:WHEN (PSEUDOHOSTP HOST) (* ; THEN (CL:WHEN (PSEUDOHOSTP HOST) (* ;
@ -121,10 +127,12 @@
HOST]) HOST])
(PSEUDOHOSTP (PSEUDOHOSTP
[LAMBDA (HOST) (* ; "Edited 18-Jan-2022 11:29 by rmk") [LAMBDA (HOST) (* ; "Edited 24-Feb-2022 23:51 by rmk")
(* ; "Edited 18-Jan-2022 11:29 by rmk")
(LET ((DEV (\GETDEVICEFROMNAME HOST T T))) (LET ((DEV (\GETDEVICEFROMNAME HOST T T)))
(CL:WHEN (AND DEV (TYPE? FDEV (FETCH (PHDEVICE TARGETDEV) OF DEV))) (CL:WHEN (AND DEV (TYPE? FDEV (FETCH (PHDEVICE TARGETDEV) OF DEV)))
(LIST HOST (FETCH (PHDEVICE PREFIX) (LIST (FETCH (FDEV DEVICENAME) OF DEV)
(FETCH (PHDEVICE PREFIX)
DEV)))]) DEV)))])
(PSEUDOHOSTS (PSEUDOHOSTS
@ -470,12 +478,12 @@
(LOAD 'EXPORTS.ALL)) (LOAD 'EXPORTS.ALL))
) )
(DECLARE%: DONTCOPY (DECLARE%: DONTCOPY
(FILEMAP (NIL (1226 8796 (PSEUDOHOST 1236 . 6496) (PSEUDOHOSTP 6498 . 6848) (PSEUDOHOSTS 6850 . 7207) (FILEMAP (NIL (1239 9187 (PSEUDOHOST 1249 . 6724) (PSEUDOHOSTP 6726 . 7239) (PSEUDOHOSTS 7241 . 7598)
(TARGETHOST 7209 . 7483) (TRUEFILENAME 7485 . 8172) (PSEUDOFILENAME 8174 . 8794)) (8824 16095 ( (TARGETHOST 7600 . 7874) (TRUEFILENAME 7876 . 8563) (PSEUDOFILENAME 8565 . 9185)) (9215 16486 (
EXPAND.PH 8834 . 10108) (CONTRACT.PH 10110 . 12775) (SLASHIT 12777 . 14345) (UNSLASHIT 14347 . 16093)) EXPAND.PH 9225 . 10499) (CONTRACT.PH 10501 . 13166) (SLASHIT 13168 . 14736) (UNSLASHIT 14738 . 16484))
(16096 22886 (OPENFILE.PH 16106 . 16667) (GETFILENAME.PH 16669 . 16958) (DIRECTORYNAMEP.PH 16960 . (16487 23277 (OPENFILE.PH 16497 . 17058) (GETFILENAME.PH 17060 . 17349) (DIRECTORYNAMEP.PH 17351 .
17584) (CLOSEFILE.PH 17586 . 17940) (REOPENFILE.PH 17942 . 18507) (DELETEFILE.PH 18509 . 18793) ( 17975) (CLOSEFILE.PH 17977 . 18331) (REOPENFILE.PH 18333 . 18898) (DELETEFILE.PH 18900 . 19184) (
OPENP.PH 18795 . 18971) (UNREGISTERFILE.PH 18973 . 19278) (REGISTERFILE.PH 19280 . 19581) ( OPENP.PH 19186 . 19362) (UNREGISTERFILE.PH 19364 . 19669) (REGISTERFILE.PH 19671 . 19972) (
GENERATEFILES.PH 19583 . 20623) (GETFILEINFO.PH 20625 . 20927) (SETFILEINFO.PH 20929 . 21128) ( GENERATEFILES.PH 19974 . 21014) (GETFILEINFO.PH 21016 . 21318) (SETFILEINFO.PH 21320 . 21519) (
NEXTFILEFN.PH 21130 . 21672) (FILEINFOFN.PH 21674 . 21945) (RENAMEFILE.PH 21947 . 22884))))) NEXTFILEFN.PH 21521 . 22063) (FILEINFOFN.PH 22065 . 22336) (RENAMEFILE.PH 22338 . 23275)))))
STOP STOP

BIN
lispusers/PSEUDOHOSTS.LCOM
View File

Binary file not shown.

31
lispusers/comparetext
View File

@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "19-Feb-2022 12:01:45"  (FILECREATED "25-Feb-2022 14:36:43" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>comparetext.;115 46109 {DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>comparetext.;116 46252
:CHANGES-TO (FNS COMPARETEXT.WINDOW) :CHANGES-TO (FNS COMPARETEXT.WINDOW)
:PREVIOUS-DATE "18-Feb-2022 17:05:22" :PREVIOUS-DATE "19-Feb-2022 12:01:45"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>comparetext.;114) {DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>comparetext.;115)
(* ; " (* ; "
@ -58,7 +58,8 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
HASH.TYPE REGION FILELABELS TITLE]) HASH.TYPE REGION FILELABELS TITLE])
(COMPARETEXT.WINDOW (COMPARETEXT.WINDOW
[LAMBDA (GRAPH REGION TITLE) (* ; "Edited 19-Feb-2022 12:01 by rmk") [LAMBDA (GRAPH REGION TITLE) (* ; "Edited 25-Feb-2022 14:34 by rmk")
(* ; "Edited 19-Feb-2022 12:01 by rmk")
(* ; "Edited 2-Feb-2022 17:29 by rmk") (* ; "Edited 2-Feb-2022 17:29 by rmk")
(* ; "Edited 23-Jan-2022 18:18 by rmk") (* ; "Edited 23-Jan-2022 18:18 by rmk")
(* ; "Edited 12-Jan-2022 10:06 by rmk") (* ; "Edited 12-Jan-2022 10:06 by rmk")
@ -68,8 +69,8 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
(LET [WINDOW GRAPHREGION WIDTH HEIGHT (FILEPREFIX (CAR (GRAPHERPROP GRAPH 'FILELABELS] (LET [WINDOW GRAPHREGION WIDTH HEIGHT (FILEPREFIX (CAR (GRAPHERPROP GRAPH 'FILELABELS]
(SETQ GRAPHREGION (GRAPHREGION GRAPH)) (SETQ GRAPHREGION (GRAPHREGION GRAPH))
(SETQ WIDTH (IPLUS (TIMES 2 WBorder) [SETQ WIDTH (IMIN SCREENWIDTH (IPLUS (TIMES 2 WBorder)
(FETCH (REGION WIDTH) OF GRAPHREGION))) (FETCH (REGION WIDTH) OF GRAPHREGION]
[SETQ HEIGHT (IMIN 200 (IPLUS (FETCH (REGION HEIGHT) OF GRAPHREGION) [SETQ HEIGHT (IMIN 200 (IPLUS (FETCH (REGION HEIGHT) OF GRAPHREGION)
(ITIMES 2 (FONTHEIGHT DEFAULTFONT] (ITIMES 2 (FONTHEIGHT DEFAULTFONT]
(SETQ REGION (SETQ REGION
@ -736,12 +737,12 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
) )
(PUTPROPS COMPARETEXT COPYRIGHT ("Xerox Corporation" 1984 1985 1993 1998)) (PUTPROPS COMPARETEXT COPYRIGHT ("Xerox Corporation" 1984 1985 1993 1998))
(DECLARE%: DONTCOPY (DECLARE%: DONTCOPY
(FILEMAP (NIL (1344 38729 (COMPARETEXT 1354 . 2854) (COMPARETEXT.WINDOW 2856 . 6214) ( (FILEMAP (NIL (1344 38872 (COMPARETEXT 1354 . 2854) (COMPARETEXT.WINDOW 2856 . 6357) (
COMPARETEXT.TEXTOBJ 6216 . 8924) (COMPARETEXT.SETSEL 8926 . 9716) (CHUNKNODELABEL 9718 . 10839) ( COMPARETEXT.TEXTOBJ 6359 . 9067) (COMPARETEXT.SETSEL 9069 . 9859) (CHUNKNODELABEL 9861 . 10982) (
IMCOMPARE.BOXNODE 10841 . 11608) (IMCOMPARE.CHUNKS 11610 . 15986) (IMCOMPARE.COLLECT.HASH.CHUNKS 15988 IMCOMPARE.BOXNODE 10984 . 11751) (IMCOMPARE.CHUNKS 11753 . 16129) (IMCOMPARE.COLLECT.HASH.CHUNKS 16131
. 18905) (IMCOMPARE.DISPLAYGRAPH 18907 . 26750) (IMCOMPARE.HASH 26752 . 30939) ( . 19048) (IMCOMPARE.DISPLAYGRAPH 19050 . 26893) (IMCOMPARE.HASH 26895 . 31082) (
IMCOMPARE.MERGE.CONNECTED.CHUNKS 30941 . 34437) (IMCOMPARE.MERGE.UNCONNECTED.CHUNKS 34439 . 36394) ( IMCOMPARE.MERGE.CONNECTED.CHUNKS 31084 . 34580) (IMCOMPARE.MERGE.UNCONNECTED.CHUNKS 34582 . 36537) (
IMCOMPARE.SHOW.DIST 36396 . 36842) (IMCOMPARE.UPDATE.SYMBOL.TABLE 36844 . 38727)) (38730 44887 ( IMCOMPARE.SHOW.DIST 36539 . 36985) (IMCOMPARE.UPDATE.SYMBOL.TABLE 36987 . 38870)) (38873 45030 (
IMCOMPARE.LEFTBUTTONFN 38740 . 41317) (IMCOMPARE.MIDDLEBUTTONFN 41319 . 44435) (IMCOMPARE.COPYBUTTONFN IMCOMPARE.LEFTBUTTONFN 38883 . 41460) (IMCOMPARE.MIDDLEBUTTONFN 41462 . 44578) (IMCOMPARE.COPYBUTTONFN
44437 . 44885)) (44940 45631 (TAIL1 44950 . 45304) (TAIL2 45306 . 45629))))) 44580 . 45028)) (45083 45774 (TAIL1 45093 . 45447) (TAIL2 45449 . 45772)))))
STOP STOP