From d3b1c6a3b41d1643320017a5763ee6fa01c3ba1a Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Sat, 26 Feb 2022 22:16:07 -0800 Subject: [PATCH] Further cleanup of comparison functions Mostly for cosmetics or convenience, a few glitches --- lispusers/COMPAREDIRECTORIES | 304 ++++++++++++++++++------------ lispusers/COMPAREDIRECTORIES.LCOM | Bin 39205 -> 40030 bytes lispusers/COMPARESOURCES | 177 ++++++++--------- lispusers/COMPARESOURCES.LCOM | Bin 17097 -> 17450 bytes lispusers/COMPARETEXT.LCOM | Bin 10916 -> 10951 bytes lispusers/EXAMINEDEFS | 25 ++- lispusers/EXAMINEDEFS.LCOM | Bin 3953 -> 4026 bytes lispusers/PSEUDOHOSTS | 42 +++-- lispusers/PSEUDOHOSTS.LCOM | Bin 8106 -> 8239 bytes lispusers/comparetext | 31 +-- 10 files changed, 336 insertions(+), 243 deletions(-) diff --git a/lispusers/COMPAREDIRECTORIES b/lispusers/COMPAREDIRECTORIES index c4afea93..abd0eba0 100644 --- a/lispusers/COMPAREDIRECTORIES +++ b/lispusers/COMPAREDIRECTORIES @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "18-Feb-2022 17:05:27"  -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;189 119161 +(FILECREATED "25-Feb-2022 21:30:55"  +{DSK}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" -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;188) + :PREVIOUS-DATE "24-Feb-2022 21:13:32" +{DSK}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.") - (FNS COMPAREDIRECTORIES COMPAREDIRECTORIES.INFOS CDENTRIES.SELECT - COMPAREDIRECTORIES.INFOS.TYPE MATCHNAME CD.INSURECDVALUE CD.UPDATEWIDTHS) + (FNS COMPAREDIRECTORIES COMPAREDIRECTORIES.INFOS COMPAREDIRECTORIES.CANDIDATES + CDENTRIES.SELECT COMPAREDIRECTORIES.INFOS.TYPE MATCHNAME CD.INSURECDVALUE + CD.UPDATEWIDTHS) (FNS CDFILES CDFILES.MATCH CDFILES.PATS) (FNS CDPRINT CDPRINT.HEADER CDPRINT.LINE CDPRINT.MAXWIDTHS CDPRINT.COLHEADERS CDPRINT.COLUMNS CDTEDIT) @@ -65,7 +66,8 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp (COMPAREDIRECTORIES [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 26-Jan-2022 13:33 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] - (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.") @@ -121,10 +123,13 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp (PRINTOUT T " ... ") (SETQ INFOS1 (COMPAREDIRECTORIES.INFOS (CDFILES DIR1 INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH1) - USEDIRECTORYDATE DIR1)) + USEDIRECTORYDATE DIR1 ALLVERSIONS)) (SETQ INFOS2 (COMPAREDIRECTORIES.INFOS (CDFILES DIR2 INCLUDEDFILES EXCLUDEDFILES 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 CDDIR1 _ DIR1 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) (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") - (* ;; - "Look through all of the I2's because multiple versions (if VERSIONS) have the same matchname") - - [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)) - - (* ;; "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)) + (SETQ CDENTRIES (SORT (CDENTRIES.SELECT (COMPAREDIRECTORIES.CANDIDATES INFOS1 INFOS2) + SELECT) + T)) (PRINTOUT T (LENGTH CDENTRIES) " entries" T) (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]) (COMPAREDIRECTORIES.INFOS - [LAMBDA (FILES USEDIRECTORYDATE DIR) (* ; "Edited 4-Jan-2022 15:23 by rmk") - (* ; "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:") + [LAMBDA (FILES USEDIRECTORYDATE DIR ALLVERSIONS) - (* ;; "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 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.") (SETQ LDATE (OR (FILEDATE STREAM T) (FILEDATE STREAM))) - (PROG1 (CONS (MATCHNAME FULLNAME STARTPOS) + (PROG1 (LIST (MATCHNAME FULLNAME STARTPOS) (CREATE CDINFO - FULLNAME _ FULLNAME + FULLNAME _ (FULLNAME STREAM) DATE _ (GDATE (IDATE (IF (OR USEDIRECTORYDATE (NULL LDATE)) THEN (GETFILEINFO STREAM 'CREATIONDATE) 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) TYPE _ (COMPAREDIRECTORIES.INFOS.TYPE STREAM LDATE) 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 - [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") - (for C MATCHNAME INFO1 INFO2 IDATE1 IDATE2 DATEREL BINCOMP [COMPAREDATE - _ - (INTERSECTION SELECT - '(< > =] in CANDIDATES - eachtime (SETQ MATCHNAME (pop C)) - (SETQ INFO1 (pop C)) - (SETQ INFO2 (pop C)) + (for CDE MATCHNAME INFO1 INFO2 IDATE1 IDATE2 DATEREL BINCOMP + [COMPAREDATE _ (INTERSECTION SELECT '(< > =] in CANDIDATES + eachtime (SETQ MATCHNAME (FETCH (CDENTRY MATCHNAME) OF CDE)) + (SETQ INFO1 (FETCH (CDENTRY INFO1) OF CDE)) + (SETQ INFO2 (FETCH (CDENTRY INFO2) OF CDE)) (if (AND INFO1 INFO2) then (SETQ IDATE1 (IDATE (fetch DATE of INFO1))) (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 (* ;; "OK if INFO1 is missing?") - (MEMB '-* SELECT)) - collect (create CDENTRY - MATCHNAME _ MATCHNAME - INFO1 _ INFO1 - DATEREL _ DATEREL - INFO2 _ INFO2 - EQUIV _ (CL:UNLESS (EQ DATEREL '*) - BINCOMP]) + (MEMB '-* SELECT)) collect (REPLACE (CDENTRY DATEREL) OF CDE WITH DATEREL) + (REPLACE (CDENTRY EQUIV) OF CDE + WITH (CL:UNLESS (EQ DATEREL '*) + BINCOMP)) + CDE]) (COMPAREDIRECTORIES.INFOS.TYPE [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]) (MATCHNAME - [LAMBDA (NAME STARTPOS) (* ; "Edited 23-Dec-2021 22:41 by rmk") - (* ; "Edited 5-Sep-2020 13: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:") - (* ;; "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") (CL:IF (EQ (CHARCODE %.) (NTHCHARCODE M -1)) (SUBATOM M 1 -2) - M)]) + (MKATOM M))]) (CD.INSURECDVALUE [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 (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 5-Jan-2022 15:07 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)) (LET ([INCLUDES (CDFILES.PATS (OR INCLUDEDFILES '*.*] (EXCLUDES (AND EXCLUDEDFILES (CDFILES.PATS EXCLUDEDFILES))) - (TOPDIR (DIRECTORYNAME (OR DIR T))) HOST FILING.ENUMERATION.DEPTH ENUMPAT) (DECLARE (SPECVARS FILING.ENUMERATION.DEPTH)) - (SETQ HOST (FILENAMEFIELD TOPDIR 'HOST)) - (SETQ TOPDIR (FILENAMEFIELD TOPDIR 'DIRECTORY)) + (SETQ HOST (FILENAMEFIELD DIR 'HOST)) + (SETQ DIR (FILENAMEFIELD DIR 'DIRECTORY)) [SETQ FILING.ENUMERATION.DEPTH (IF (EQ DEPTH T) THEN MAX.SMALLP 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.") (SETQ ENUMPAT (PACKFILENAME 'HOST HOST 'DIRECTORY - (CONCAT "<" TOPDIR ">" - (OR SD "")) + (CONCAT "<" DIR ">" (OR SD "")) 'NAME N 'EXTENSION E 'VERSION (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") - (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 "*" "")) @@ -1651,9 +1688,10 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp BROWSER)]) (CDBROWSER.STRINGS - [LAMBDA (CDVALUE COLHEADINGS SEPARATEDIRECTIONS) (* ; "Edited 14-Dec-2021 21:03 by rmk") - (* ; "Edited 8-Dec-2021 11:22 by rmk") - (* ; "Edited 27-Nov-2021 21:37 by rmk:") + [LAMBDA (CDVALUE COLHEADINGS SEPARATEDIRECTIONS) (* ; "Edited 22-Feb-2022 18:30 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:") (* ;; "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) THEN 'LEFT ELSE 'RIGHT)) + ((R C) (* ; "Renamed or copied") + (FETCH DATEREL OF CDENTRY)) (SHOULDNT))) (* ;; "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]) (CD.TABLEITEM.COPYFN - [LAMBDA (CDBROWSER ITEM) (* ; "Edited 25-Dec-2021 12:58 by rmk") - (LET [(CDENTRY (CADR (FETCH TIDATA OF ITEM] - (SELECTQ [MENU (CREATE MENU - TITLE _ "Which File?" - ITEMS _ '(Left Right] - (Left (COPYINSERT (FETCH (CDINFO FULLNAME) OF (FETCH (CDENTRY INFO1) OF CDENTRY)))) - (Right (COPYINSERT (FETCH (CDINFO FULLNAME) OF (FETCH (CDENTRY INFO2) OF CDENTRY)))) - NIL]) + [LAMBDA (CDBROWSER ITEM) (* ; "Edited 24-Feb-2022 21:12 by rmk") + (* ; "Edited 25-Dec-2021 12:58 by rmk") + (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?" + ITEMS _ '(Left Right] + (Left LEFT) + (Right RIGHT) + NIL) + ELSE (OR LEFT RIGHT))) + (CL:WHEN FILE + (PUTCLIPBOARD FILE) + (COPYINSERT FILE))]) (CDTABLEBROWSER.HEADING.REPAINTFN [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]) (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 10-Jan-2022 22:51 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)) (USERDATA (TB.USERDATA CDBROWSER)) (CDVALUE (LISTGET USERDATA 'CDVALUE)) - (FN (CADR (LISTP MENUITEM] + (FN (CADR (LISTP MENUITEM))) + (MIDDLE (EQ KEY 'MIDDLE] (DECLARE (SPECVARS WINDOW PWINDOW CDVALUE USERDATA)) (GIVE.TTY.PROCESS 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)) (FLASHWINDOW PWINDOW) (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 [FUNCTION (LAMBDA (CDBROWSER 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))) (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.") (CLEARW T) (CL:FUNCALL FN TBITEM MENUITEM CDBROWSER KEY] - (FUNCTION NILL]))]) + (FUNCTION NILL)) + (CL:WHEN MIDDLE (PRIN3 " Done" PWINDOW]))]) (CD-MENUFN [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.") @@ -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 2018 2020 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2555 19321 (COMPAREDIRECTORIES 2565 . 9265) (COMPAREDIRECTORIES.INFOS 9267 . 11387) ( -CDENTRIES.SELECT 11389 . 16075) (COMPAREDIRECTORIES.INFOS.TYPE 16077 . 16705) (MATCHNAME 16707 . 17237 -) (CD.INSURECDVALUE 17239 . 18853) (CD.UPDATEWIDTHS 18855 . 19319)) (19322 29594 (CDFILES 19332 . -25688) (CDFILES.MATCH 25690 . 27315) (CDFILES.PATS 27317 . 29592)) (29595 44680 (CDPRINT 29605 . 31950 -) (CDPRINT.HEADER 31952 . 32849) (CDPRINT.LINE 32851 . 35407) (CDPRINT.MAXWIDTHS 35409 . 39524) ( -CDPRINT.COLHEADERS 39526 . 40164) (CDPRINT.COLUMNS 40166 . 44045) (CDTEDIT 44047 . 44678)) (44681 -53050 (CDMAP 44691 . 46123) (CDENTRY 46125 . 46434) (CDSUBSET 46436 . 47875) (CDMERGE 47877 . 51731) ( -CDMERGE.COMMON 51733 . 53048)) (53051 60589 (BINCOMP 53061 . 57350) (EOLTYPE 57352 . 59914) ( -EOLTYPE.SHOW 59916 . 60587)) (61117 74324 (FIND-UNCOMPILED-FILES 61127 . 64770) (FIND-UNSOURCED-FILES -64772 . 67581) (FIND-SOURCE-FILES 67583 . 69287) (FIND-COMPILED-FILES 69289 . 71367) ( -FIND-UNLOADED-FILES 71369 . 72113) (FIND-LOADED-FILES 72115 . 72669) (FIND-MULTICOMPILED-FILES 72671 - . 74322)) (74325 82527 (CREATED-AS 74335 . 79132) (SOURCE-FOR-COMPILED-P 79134 . 81832) ( -COMPILE-SOURCE-DATE-DIFF 81834 . 82525)) (82528 92834 (FIX-DIRECTORY-DATES 82538 . 85531) ( -FIX-EQUIV-DATES 85533 . 87058) (COPY-COMPARED-FILES 87060 . 88881) (COPY-MISSING-FILES 88883 . 91040) -(COMPILED-ON-SAME-SOURCE 91042 . 92832)) (93028 100070 (CDBROWSER 93038 . 96965) (CDBROWSER.STRINGS -96967 . 100068)) (100232 101504 (CD.TABLEITEM 100242 . 100462) (CD.TABLEITEM.PRINTFN 100464 . 100663) -(CD.TABLEITEM.COPYFN 100665 . 101259) (CDTABLEBROWSER.HEADING.REPAINTFN 101261 . 101502)) (101505 -118577 (CDTABLEBROWSER.WHENSELECTEDFN 101515 . 101983) (CD.COMMANDSELECTEDFN 101985 . 105485) ( -CD-MENUFN 105487 . 111662) (CDBROWSER-COPY 111664 . 115035) (CDBROWSER-DELETE-FILE 115037 . 118056) ( -CD-SWAPDIRS 118058 . 118575))))) + (FILEMAP (NIL (2597 22158 (COMPAREDIRECTORIES 2607 . 7834) (COMPAREDIRECTORIES.INFOS 7836 . 10598) ( +COMPAREDIRECTORIES.CANDIDATES 10600 . 13985) (CDENTRIES.SELECT 13987 . 18762) ( +COMPAREDIRECTORIES.INFOS.TYPE 18764 . 19392) (MATCHNAME 19394 . 20074) (CD.INSURECDVALUE 20076 . 21690 +) (CD.UPDATEWIDTHS 21692 . 22156)) (22159 32408 (CDFILES 22169 . 28502) (CDFILES.MATCH 28504 . 30129) +(CDFILES.PATS 30131 . 32406)) (32409 47494 (CDPRINT 32419 . 34764) (CDPRINT.HEADER 34766 . 35663) ( +CDPRINT.LINE 35665 . 38221) (CDPRINT.MAXWIDTHS 38223 . 42338) (CDPRINT.COLHEADERS 42340 . 42978) ( +CDPRINT.COLUMNS 42980 . 46859) (CDTEDIT 46861 . 47492)) (47495 55864 (CDMAP 47505 . 48937) (CDENTRY +48939 . 49248) (CDSUBSET 49250 . 50689) (CDMERGE 50691 . 54545) (CDMERGE.COMMON 54547 . 55862)) (55865 + 63403 (BINCOMP 55875 . 60164) (EOLTYPE 60166 . 62728) (EOLTYPE.SHOW 62730 . 63401)) (63931 77138 ( +FIND-UNCOMPILED-FILES 63941 . 67584) (FIND-UNSOURCED-FILES 67586 . 70395) (FIND-SOURCE-FILES 70397 . +72101) (FIND-COMPILED-FILES 72103 . 74181) (FIND-UNLOADED-FILES 74183 . 74927) (FIND-LOADED-FILES +74929 . 75483) (FIND-MULTICOMPILED-FILES 75485 . 77136)) (77139 85341 (CREATED-AS 77149 . 81946) ( +SOURCE-FOR-COMPILED-P 81948 . 84646) (COMPILE-SOURCE-DATE-DIFF 84648 . 85339)) (85342 95648 ( +FIX-DIRECTORY-DATES 85352 . 88345) (FIX-EQUIV-DATES 88347 . 89872) (COPY-COMPARED-FILES 89874 . 91695) + (COPY-MISSING-FILES 91697 . 93854) (COMPILED-ON-SAME-SOURCE 93856 . 95646)) (95842 103188 (CDBROWSER +95852 . 99779) (CDBROWSER.STRINGS 99781 . 103186)) (103350 105086 (CD.TABLEITEM 103360 . 103580) ( +CD.TABLEITEM.PRINTFN 103582 . 103781) (CD.TABLEITEM.COPYFN 103783 . 104841) ( +CDTABLEBROWSER.HEADING.REPAINTFN 104843 . 105084)) (105087 123647 (CDTABLEBROWSER.WHENSELECTEDFN +105097 . 105565) (CD.COMMANDSELECTEDFN 105567 . 110555) (CD-MENUFN 110557 . 116732) (CDBROWSER-COPY +116734 . 120105) (CDBROWSER-DELETE-FILE 120107 . 123126) (CD-SWAPDIRS 123128 . 123645))))) STOP diff --git a/lispusers/COMPAREDIRECTORIES.LCOM b/lispusers/COMPAREDIRECTORIES.LCOM index 09ed9544f877f1c925c6a0b267854564f63ca1e7..da14e6c2ce59e61b8b25aafbbd55eb4eb4b62a81 100644 GIT binary patch delta 4479 zcmZu#Z){uD7595in>J0|#BoC!N_%TcaH7Wez30CvEqSqD;@3XEYwYKm6pCri^2I2PONE8c7jFjjEbL#?o2co-&G~4ke*UyVyn28L`4J8Os-pBPJ~s zM>D!(kf0h}x2>X$X)0e1`?9Qj+dd@%-6OhHGDx1JNXE!JSruf`B^8hfNEo(LFxi6K z>{AqC=|!ilG)&~Xwy;aye`v?M#?LKxdGL3dH%qUbsr0nQ&z}2g3m=~FwDhk}``KK_ z!?*Wr-M|Hm@hM+7Cywdq%#@G%+iV?dcI$@WodNsJT(hGmXNx^1M0-ZG6(9S21E~k7 zZwC!*=4;Tv$^Oa4d)3LBIEyPRR`2nIVzD?blrNaJLt-(7~v2Byo%aBtgOu&`?M;mAXl3#4_wDCrhHq7`d%T3l51UQY+Rnis7PR8EMYc*upD) z+rnwx&X|0MB8jRh=dp(_cW#R+8kEEbBw8x9!e>V3pS-bXjNQKJHE%2uW53$;>K=&Z zY9L92r(VqvLCry@CA^(smDNi_hcf7@rVkI{QiQ zW1F(x=I%qTA$#?$)L#jBo8IRaJWV{Sstw-% zURJ(uVfmmn^#1&pQl($247TVX4akzT)aXZF3A8ABNtS58Jh)^2?-&gXRt8#_TUg%i z2`MR9z@kNC@*bij;>4hqGo3ex5?`^#Mt1q~#<~)ZkSW9Amoe>0N|b1F{aA~WDdG4E z!bF%FmeNRZtxhDdPA3K9lq}2Ea|TJmy1J9jia|mXRujv`qnxfAVgLuCdBZL`1w+q~ zs75k~IipZC2x42fL7dnK(L!;!E2P9?L@zm6TEJ;(93$Zoc@hJsO-4vwHw#7X z8CZXk7FCe&9Zo94#Pgr69*;ck`ojs2-X`SUe8;%nTMur^HBQ@&<2k9~YuOSaocgK~ z?ZI~*kf=|lJu=*5FgtiHCx2keAI|@QPl_mQ+(La^q*fceDROLn5!2wT>T#tX<(fO} z#$EROa8;U?%vF{8HQC$zY`(uL9pzewRyO0@zHG13P5s{H20G9qRRZus?q1UT-l}vR z1SsgePy4OfVSa!?*8`#YPyByM{c^=W|4UCOsS@4F<8x&Ue6iTd_vD{-xTDK9E%w}& z$K;H`zSuGO)}A{sF65u(K+WE5RAN=8PB7SYJJ4-hpKBWM$`^{%MG`|l=d>}wvXMip`p z8>`S!po13Sc{hxv@irRavzp4=2;WkPL?DxjZoq6(S#0@!CIu%XxSKGI3)SPga2A2p z0&+I97khT;f&_NQ5ub;3hvo<@RV+;i5>aJ4Ssrg`nlT7=EZIfmsI2MWE~GS?){BcD z^}H(Aqa+PeL#fq7|%h(b7P(QxL-Fr|Vpp_6RBJ7hSq>R`l~{u)J_}`z7kLznG&w zxc;$)ci>Y@HYTZxwgH zo|Rv(UF)-I)$|X=3BR*?&T-)q$Y66wB|PYNBItvHSs4+_-&xt)qATQ3i|$<{bf~f2 zz4MUR01~wdpL!EB&$z;M&z*G8oej0lR(s_E8lqvrsLmW*daF8f*HWXeMI&cFu0&ci zj4s@o|8((78u3^5wX%&q$nT{?bYIpjVH$U=Fie-R7@)xlY0+KHK1ynXm0gvcEjl1q z1{RjbD5(!scD3gJjXEW+tW*VIk(5Xb!P>49+MFno*IM64rLh_okmlYzLZZkmu4nVa zDO^}fD(w_SG=%O-UYRD^foMXg-4x|@XPVk+IIRM5g+FN;R)(Yy2<4xIZVYLF))4>>;0Hmf@fNuot(qh}mvUhh5xJ_WDp6NeNk-QkSV<&B z2myTfDoP}}byl9qpUjE_uA;&5h-e6CU|0Y9r}c=D%=Zqtsbl@cfy*aDiA()%EBrZj8-m+T*v| zeFM2@NS0o9!)VCucDE;g((Yg8GRPn|F2tog+kWxkhj5Yyfc17-B^oY$lSYwwv*gf# z_p5^_(#1+jQ1KlAVklEgdkXNKM2R(qnju1UNEP!4uBJ-y)g;U z)Zk~ZJ|+N)N%p|w$K`~=T91D==$1r4FSV@%pmUYjyHDJ)_j{=2Wql)ukY95o(mS#! z0;jVaHl(9waU;vHJC@73gY-aBbgyu4R7THR9FI=gp?~(EZh`zN(NoELy<7 z!VgCC)23ZCP;4vk6;w!R%gj$uy#Q~FA_v+fUUdO}3ujK(E{d#Uo%+^A66dd*Nxft_ zIfK3X=;m!mR%r|6J#r~7A7gJnxyz5LDZyaP`{^EX?FFgz1;-Q z3-}_UGZvkh;iUYRRcW(X__Yp5PS7*_!TTc2~V#X9W z*m84-kPx!=)var$aa|QTlfRcV1XqkW6M(C{`x>e{MkdS;TNEXWE2IGG^y1+XzAEYl zl-fLdmrXlEVJ^h(iskS~n=+3WVaJ&cxfH4oHL@r+ut6H^wf{ z4MO3aIfFgc835J6?)4wRlZu3>Z4?clVupme*nul1n`hnr(3&45xNV2K7Jtji8~z7u C{z?D< delta 3658 zcmZu!Yit|G5#}8&%a$#bq$pZqTzSH{3Z+^s?~YIT5uM1R?ridw<{d4|kI+e&nu=d( zVkb6YhenVeMbn~9SF#cRsB5Qbi}sHmA(}qi1KR${kNzu=zJa!AfC5DzI6s0SMb+6o z(vpiB^3Lwu&g|^$%s0b7zbC%4EPi7qC}qYA&ptga$7LC$^h7*4A*bIw^W-KelO3gx z3IlKcHQYU3(#&eXq=GR0fA`Z9f>}fXkff}Xl3*gItLC(3joSpG1=H$*T)wSi6eh|Q z?TA6D)_7jEHHb*k1_M$PvV?z3;Tb8D8STlDQdzBNd84A`Y*H~a3nucJo@g1+UPFd5 zNJu3{B|PPbTC8ep5r@21wsp24>rUC83~td(o2w~98giNfi6rqO1|{7&ialIQpSxL8_zxi0vH?bChBWz(njHXwZ1wY8X~*Bt)pZlz;89jNBlD7PJDE-3z{L~8zP~t>`o-~Osue? z`uJj2A6k4%sO=F*UufmCWRK7wdtB?r91?BylQFa|S{rf5Zn3s|Y3)@qHd2c^i}y*W z(BKYqkJ-*N`#jM!#!D_=t{A2b>0}B@T4@SWnP!4N2BgyLbF5ls!7^jyZQX)YG7Gj= zK^dIl3!|(AsYJXpQ&3hjr)?cla%%m>W0qFLAcB;X28&eKM1m7$j+i+a5)#J7hFGKb z=ypGH+35wNh+(H>(?FN#AU(DDkKS}LPM_$$?M)?8^e^4F=(o0H=!aWIc6eIoB=6)D zch#BS`d`?hds~|h(gRzgLW!Q+dU9`=xPEkgcBs``Y=n>hL>G@Ptvyv7`RU>(o~V>W zJBq~83QvHPP(UL^d$z2Bq@>vC!%ay}!?b2In+&r+Fzk~Luj2|#^UTU-fW@{3**I7m zB+`k81eniNJExm!NrOZRm}V}fq}S(i7D!n$Elfd8EkO!QO!0~}+7p#957nxzlM0#= z?>IiAKn{1>1~Iv=RQBPuoB+ctSM5>y!S)yEq26)fEqbMQr@tiL`*}&gvDW8sO7HaE z6@EqYeYcyBnWT?kSdx&Nhj+=~b(R+4hdlY8>upae7+5@*6e;0O~OU1xqK@VjkmA$||megwe-!NJ**b&e8}s?v>*03C0KpuU4@zxbVK{6D6I7F;J38 z7)O%G!q_+{@eI7WA4wecgPe)~k3Y~s`#?@2ByDt?jPG#(q)ZxRBngF(q>{Lkg$a&{ zB>RjHg(I3VhPao+J$RRWkV&l!_-kR1-MqkHs}^#&)WJB|1HOO1MNfwN!dBRBP62eH1ngH@z1 zGVBv-yE(JAhgX4BYAkpOk_uf&rbc{F+#QG)~c^f}n>+B{w-LGTLnYv#b zB4Z@Z8TGRVR^O?g{le;UzeD6Rzp2R%i6eW*MX9B}Y9^?u_iwlXMWKLwD)33~elES)#Vh^^;ywaFCjB!k9 z4zWx{!O)6%%mx>L*Ev~vT^Zxjo*|`~-grU+GZ_;Q(HYSP5}2m0NpgmPP@F-LjQ7A1 z;Q~j5izA3uY_qKJ+--}>nDAVb;otfV82s>LlMwq5VkD(+}ikquJ^Si;WRya z@x{%akLpXFU(&x{1Z8iXN8##CH}w`j-(G*eO_wnbMnqwO?|Ore^zfyWFh{?9>A6#> z#Dhw&VE53e`pmpMwxbNZ5vZjN3&g+&^+3kn0^!cW#?hQcr(tm`P9RR_#}S`21jYod zywn&#NUIprx(#wRg@v$y6Ddvq@X}Kvb_oYw{)p~VO$wJ&tb(M3Vv9G`pjcYAe)8Eqc+3Ru{3q&#bwmWJ&NhTw)(nzd49l~rgg zIhDE7jf;?xq4?|?usoa=U%g@-e2x z!Z>srK82OL0(S2DjA7=<4B+n&l)#!XrB!02(B6(IW81TN!zvfmS$s*>#$Y^88%MMl zeu&|{LpjZ|Ai)o;qD!&Ns~FJqa5EU>J(KI3_AyctKlF!_FjGL6b$rdT&nOnrx-|W6 z6DBgO)TSzA22WyDu%sHMs~X=787s%HKi==_{9NfYuh;`d zg&z7lx}WZtAH~_^yh1O|@4?x(=Tr29`B<OtxfL>iF z(zTf(aTMs^7PNt$f^l^GL9+ATWERlkaplan>Local>medley3.5>my-medley>lispusers>COMPARESOURCES.;118 41270 +(FILECREATED "25-Feb-2022 18:02:24"  +{DSK}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" -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>COMPARESOURCES.;116) + :PREVIOUS-DATE "28-Jan-2022 18:22:40" +{DSK}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 \CS.SORT.DECLARES \CS.SORT.DECLARE1 \CS.FILTER.GARBAGE) (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.PROP.NAME \CS.COMPARE.PROPS \CS.ISADDVARFORM \CS.COMPARE.ADDVARS \CS.ISFPKGCOMFORM - \CS.COMPARE.FPKGCOMS \CS.COMPARE.DEFINE-FILE-INFO) + \CS.ISRECFORM \CS.REC.NAME \CS.ISCOURIERFORM \CS.ISTEMPLATEFORM \CS.COMPARE.TEMPLATES + \CS.ISPROPFORM \CS.PROP.NAME \CS.COMPARE.PROPS \CS.ISADDVARFORM \CS.COMPARE.ADDVARS + \CS.ISFPKGCOMFORM \CS.COMPARE.FPKGCOMS \CS.COMPARE.DEFINE-FILE-INFO) [COMS (FNS CSOBJ.CREATE CSOBJ.DISPLAYFN CSOBJ.IMAGEBOXFN CSOBJ.BUTTONEVENTINFN CSOBJ.COPYBUTTONEVENTINFN) (INITVARS (COMPARESOURCES-IMAGEFNS (IMAGEFNSCREATE 'CSOBJ.DISPLAYFN 'CSOBJ.IMAGEBOXFN @@ -138,9 +139,10 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation. 'SAME]) (\CS.COMPARE.MASTERS - [LAMBDA (BODYX BODYY DW?) (* ; "Edited 18-Jan-2022 22:00 by rmk") - (* ; "Edited 19-Dec-2021 21:05 by rmk") - (* ; "Edited 5-Sep-2020 19:01 by rmk:") + [LAMBDA (BODYX BODYY DW?) (* ; "Edited 25-Feb-2022 18:02 by rmk") + (* ; "Edited 18-Jan-2022 22:00 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") (DECLARE (USEDFREE DIFFERENCES COMPARESTREAM)) (LET (YTHING XTHING PRED DIFS TMP) @@ -164,58 +166,49 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation. do (* ;; "handle definer based things") - (for DEFFER in DEFFERS do (SETQ XTHING (for X in BODYX collect X - when (EQ (CAR X) - DEFFER))) - (SETQ YTHING (for X in BODYY collect X - when (EQ (CAR X) - DEFFER))) + (for DEFFER in DEFFERS WHEN [AND (SETQ XTHING (for X in BODYX collect X + when (EQ (CAR X) + DEFFER))) + (SETQ YTHING (for X in BODYY collect X + when (EQ (CAR X) + 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 - (FUNCTION EQUALALL))) - (SETQ BODYY (CL:SET-DIFFERENCE BODYY YTHING :TEST - (FUNCTION EQUALALL))) - (COND - ((SETQ DIFS (\CS.COMPARE.TYPES - XTHING YTHING - (CONCAT (OR (CL:DOCUMENTATION TYPE - 'DEFINE-TYPES) - TYPE) - " defined by " DEFFER) - NIL - (GET DEFFER :DEFINITION-NAME))) - (COND - ((SETQ TMP (ASSOC TYPE DIFFERENCES)) - (NCONC TMP DIFS)) - (T (push DIFFERENCES (CONS TYPE DIFS] + (SETQ BODYX (CL:SET-DIFFERENCE BODYX XTHING :TEST (FUNCTION EQUALALL))) + (SETQ BODYY (CL:SET-DIFFERENCE BODYY YTHING :TEST (FUNCTION EQUALALL))) + (CL:WHEN (SETQ DIFS (\CS.COMPARE.TYPES XTHING YTHING + (CONCAT (OR (CL:DOCUMENTATION TYPE 'DEFINE-TYPES) + TYPE) + " defined by " DEFFER) + NIL + (GET DEFFER :DEFINITION-NAME) + TYPE)) + [COND + ((SETQ TMP (ASSOC TYPE DIFFERENCES)) + (NCONC TMP DIFS)) + (T (push DIFFERENCES (CONS TYPE DIFS])] (* ;; "These are for other filepkage types, as registered in COMPARESOURCETYPES") - [for TYPE in COMPARESOURCETYPES do (SETQ PRED (fetch (CSTYPE PREDFN) of TYPE)) - (SETQ XTHING (for X in BODYX collect X - when (CL:FUNCALL PRED X))) - (SETQ YTHING (for X in BODYY collect X - when (CL:FUNCALL PRED X))) - (SETQ BODYX (CL:SET-DIFFERENCE BODYX XTHING :TEST - (FUNCTION EQUALALL))) - (SETQ BODYY (CL:SET-DIFFERENCE BODYY YTHING :TEST - (FUNCTION EQUALALL))) - (COND - ([SETQ DIFS (\CS.COMPARE.TYPES - XTHING YTHING - (OR (fetch (CSTYPE TITLE) of TYPE) - (MKSTRING (fetch (CSTYPE FPKGTYPE) - of TYPE))) - (fetch (CSTYPE COMPAREFN) of TYPE) - (OR (fetch (CSTYPE IDFN) of TYPE) - (FUNCTION CADR] - (SETQ TYPE (fetch (CSTYPE FPKGTYPE) of TYPE)) - (COND - ((SETQ TMP (ASSOC TYPE DIFFERENCES)) - (NCONC TMP DIFS)) - (T (push DIFFERENCES (CONS TYPE DIFS] + [for TYPE in COMPARESOURCETYPES EACHTIME (SETQ PRED (fetch (CSTYPE PREDFN) of TYPE)) + WHEN [AND (SETQ XTHING (for X in BODYX collect X when (CL:FUNCALL PRED X))) + (SETQ YTHING (for X in BODYY collect X when (CL:FUNCALL PRED X] + do (SETQ BODYX (CL:SET-DIFFERENCE BODYX XTHING :TEST (FUNCTION EQUALALL))) + (SETQ BODYY (CL:SET-DIFFERENCE BODYY YTHING :TEST (FUNCTION EQUALALL))) + (CL:WHEN [SETQ DIFS (\CS.COMPARE.TYPES XTHING YTHING (OR (fetch (CSTYPE TITLE) + of TYPE) + (MKSTRING (fetch (CSTYPE + FPKGTYPE) + of TYPE))) + (fetch (CSTYPE COMPAREFN) of TYPE) + (OR (fetch (CSTYPE IDFN) of TYPE) + (FUNCTION CADR)) + (SETQ TYPE (fetch (CSTYPE FPKGTYPE) of TYPE] + [COND + ((SETQ TMP (ASSOC TYPE DIFFERENCES)) + (NCONC TMP DIFS)) + (T (push DIFFERENCES (CONS TYPE DIFS])] (SETQ BODYY (CL:SET-DIFFERENCE BODYY (PROG1 BODYX (SETQ BODYX (CL:SET-DIFFERENCE BODYX BODYY :TEST @@ -245,22 +238,23 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation. [COND [BODYX (COND (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) (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) (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) (push DIFFERENCES (LIST 'Other '--]) (\CS.COMPARE.TYPES - [LAMBDA (XTHING YTHING TITLE COMPAREFN IDFN) (* ; "Edited 9-Dec-2021 23:19 by rmk") - (* ; "Edited 1-Dec-2021 23:25 by rmk:") - (* ; "Edited 30-Nov-2021 23:07 by rmk:") - (* ; "Edited 27-Nov-2021 12:32 by rmk:") - (* ; "Edited 25-Nov-2021 13:29 by rmk:") + [LAMBDA (XTHING YTHING TITLE COMPAREFN IDFN TYPE) (* ; "Edited 25-Feb-2022 17:49 by rmk") + (* ; "Edited 9-Dec-2021 23:19 by rmk") + (* ; "Edited 1-Dec-2021 23:25 by rmk:") + (* ; "Edited 30-Nov-2021 23:07 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") (* ;;; "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 (FUNCTION EQUALALL))) (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.") @@ -288,12 +281,12 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation. NAME] (printout COMPARESTREAM .FONT BOLDFONT .P2 NAME .FONT DEFAULTFONT " 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) (COND (COMPAREFN (CL:FUNCALL COMPAREFN 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 TAIL) (push RESULT NAME)) @@ -301,7 +294,7 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation. do (SETQ NAME (CL:FUNCALL IDFN Y)) (printout COMPARESTREAM .FONT BOLDFONT .P2 NAME .FONT DEFAULTFONT " is not on File 1" T T) - (\CS.EXAMINE Y NIL T NAME) + (\CS.EXAMINE Y NIL T NAME TYPE) (push RESULT NAME)) RESULT)]) @@ -436,7 +429,21 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation. ) (\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 (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") (VARS \CS.ISVARFORM \CS.COMPARE.VARS) (MACROS \CS.ISMACROFORM) - (RECORDS \CS.ISRECFORM) + (RECORDS \CS.ISRECFORM NIL \CS.REC.NAME) (PROPS \CS.ISPROPFORM \CS.COMPARE.PROPS \CS.PROP.NAME "Properties") (ADDVARS \CS.ISADDVARFORM \CS.COMPARE.ADDVARS CADR "Additions to lists") (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)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1850 27174 (COMPARESOURCES 1860 . 7906) (\CS.COMPARE.MASTERS 7908 . 16052) ( -\CS.COMPARE.TYPES 16054 . 19192) (\CS.EXAMINE 19194 . 23421) (\CS.FIXFNS 23423 . 24925) ( -\CS.SORT.DECLARES 24927 . 25270) (\CS.SORT.DECLARE1 25272 . 26692) (\CS.FILTER.GARBAGE 26694 . 27172)) - (27175 31155 (\CS.ISFNFORM 27185 . 27453) (\CS.COMPARE.FNS 27455 . 27697) (\CS.FNSID 27699 . 27843) ( -\CS.ISVARFORM 27845 . 27950) (\CS.COMPARE.VARS 27952 . 28614) (\CS.ISMACROFORM 28616 . 28754) ( -\CS.ISRECFORM 28756 . 28849) (\CS.ISCOURIERFORM 28851 . 28951) (\CS.ISTEMPLATEFORM 28953 . 29051) ( -\CS.COMPARE.TEMPLATES 29053 . 29418) (\CS.ISPROPFORM 29420 . 29575) (\CS.PROP.NAME 29577 . 29722) ( -\CS.COMPARE.PROPS 29724 . 29881) (\CS.ISADDVARFORM 29883 . 29976) (\CS.COMPARE.ADDVARS 29978 . 30143) -(\CS.ISFPKGCOMFORM 30145 . 30352) (\CS.COMPARE.FPKGCOMS 30354 . 30561) (\CS.COMPARE.DEFINE-FILE-INFO -30563 . 31153)) (31156 37220 (CSOBJ.CREATE 31166 . 31579) (CSOBJ.DISPLAYFN 31581 . 32334) ( -CSOBJ.IMAGEBOXFN 32336 . 34497) (CSOBJ.BUTTONEVENTINFN 34499 . 36970) (CSOBJ.COPYBUTTONEVENTINFN 36972 - . 37218)) (38084 40788 (CSBROWSER 38094 . 40786))))) + (FILEMAP (NIL (1970 26690 (COMPARESOURCES 1980 . 8026) (\CS.COMPARE.MASTERS 8028 . 15440) ( +\CS.COMPARE.TYPES 15442 . 18708) (\CS.EXAMINE 18710 . 22937) (\CS.FIXFNS 22939 . 24441) ( +\CS.SORT.DECLARES 24443 . 24786) (\CS.SORT.DECLARE1 24788 . 26208) (\CS.FILTER.GARBAGE 26210 . 26688)) + (26691 31227 (\CS.ISFNFORM 26701 . 26969) (\CS.COMPARE.FNS 26971 . 27213) (\CS.FNSID 27215 . 27359) ( +\CS.ISVARFORM 27361 . 27466) (\CS.COMPARE.VARS 27468 . 28130) (\CS.ISMACROFORM 28132 . 28270) ( +\CS.ISRECFORM 28272 . 28600) (\CS.REC.NAME 28602 . 28921) (\CS.ISCOURIERFORM 28923 . 29023) ( +\CS.ISTEMPLATEFORM 29025 . 29123) (\CS.COMPARE.TEMPLATES 29125 . 29490) (\CS.ISPROPFORM 29492 . 29647) + (\CS.PROP.NAME 29649 . 29794) (\CS.COMPARE.PROPS 29796 . 29953) (\CS.ISADDVARFORM 29955 . 30048) ( +\CS.COMPARE.ADDVARS 30050 . 30215) (\CS.ISFPKGCOMFORM 30217 . 30424) (\CS.COMPARE.FPKGCOMS 30426 . +30633) (\CS.COMPARE.DEFINE-FILE-INFO 30635 . 31225)) (31228 37292 (CSOBJ.CREATE 31238 . 31651) ( +CSOBJ.DISPLAYFN 31653 . 32406) (CSOBJ.IMAGEBOXFN 32408 . 34569) (CSOBJ.BUTTONEVENTINFN 34571 . 37042) +(CSOBJ.COPYBUTTONEVENTINFN 37044 . 37290)) (38173 40877 (CSBROWSER 38183 . 40875))))) STOP diff --git a/lispusers/COMPARESOURCES.LCOM b/lispusers/COMPARESOURCES.LCOM index 63169175a8770cc40e2900d30c042e924fac6c80..a786c4ae0d40da6469e39ef05889379a37d94495 100644 GIT binary patch delta 2791 zcmai0OKclO81}A9AcnZ{BQGbUgH?hPYO_1LYp+cy-q`EbiM?a&4NlsUh2TKav<+%| z03qZGgy2To6^{erPze=PNZ56KL8?{=1VS7T4{?A)#g$WdiBo}pcfGNr2I0ec=AVDQ z|C@jQ$9(xJb@g@X!eT&(=2lmtn86saVv4~j%wOC%Hip@06lTSq#dwNOrdWLO=7{d^ z59<97`;V=kM&aB-p#VF(im_NMjA~DvTdg6_ZV1Wnv?r3w7vxM?mQ*>5!gx0hFV2r+ z7V#`6BvC4JL{bjRm8eQkB&Sr6NB=W5GhCK4F-0oM=y;|Q%U58UBjuw0)g$8pPlgmr zQdzE$g>pu&z^tPGOzqP(N^Pn1E1pL=7A>I?;uy3De_$yq=W=ox#%$7BVR>sMiC}M0 zR#a14bS8`X;6UvdhheU$@}gQ%;VeazLmY>)c@s!hz^p0Y%{>;CZ5_dZ$rTQpDsg1G zqcne5T`I|yX|!h(>0b}5Odj#wcW2SvcE8-D=)jXM`1yQ&wt#jA^k4VJ>h4dg>3(y? z*fhV@w8xrsgePh~xNBAvGpeLpV(^6SvX{{ zn!ejY+5u~?`MYcN+ie;Sq4eb@{e=Xd^J%G?wb9bj+OsC?Jr;J8{)Jkuap|pVu201`$2O3`xJf$&>-yNltK}1kWfs&}j4Z_nJ z-)NE4lqNQQ*U#^LP`~aC)MqT_Yh9&fg0tbCdt8S_9T7MZAS(D3$Yy3bQzaRJjZ@7z-Gg zVitx_NX#nK-NkaKzP&A(WSw0}k?U*{<2*X9Kn2NQByzUZPOXSpl>muQgo^V}T=L3c zlt@A;DWod08ts-Clt}C*jpH~#*KO=L!&=;SVhbW`R=qT>q;hqFAaEEEw=Bpop@ z>x!AK>yz7_2VLhrbSW_8W_j*X@U=STQ8bEJ7OFWpx3+o)hRpVmNpeVj{<$-&XV0#0 zo`%~4?Vh=49#YDdQ9?{2`LPA5AVH5yh&)QEaz#anc&`|4(H0AUnu0cxSMq8dTo|=_ zlMuIh3xrbCzEpu1x}XBjIJoWgVpV_;f{wlV%=&5Q*()!=gacQH(bJo!POY9kcNY3N z76lKq-uxnhcL7e|o>de*1TzdF;H8zUoq%9?+vwXFX*a%fVvi$PhFE`%P`O$edsOaZM$Ad^pchlRdDUGB0N27D~4u&y57dmQIl`C_Q z^gKAVH+y-=#!gW2@KA7u5W{x5^DG32^(4tb|3^G{%Ur;SgFNq9;2=o1 z85*V&OzW>uX`mj2!b+v7C(Qyo(e|V%%VS%EE+t>^M1a#nSvgaH6wXRe6X42_Stjz8 z5Icr5TJmsc6rt7xfVyUd?i4;(TLFQv@dK$ULEjzUi{JS-pvW79&)?;~io{N7 z#<-pf<_QXn89CH#J~}aArrCpCN`%L7xcM5JV&wH7*mt|bSVB`MgRp4*@nIAr>9lU- zDafnMw@Lb@Ao{1GxIQ+fXU(^JO4C?I@dSO-jhLQ8V+bptV&wJ7d@c{v(iF0+WVEc_ zg0_wsOO1nwz#-~PCOMv;%ILXK)H&lbPdaBOUvNF&mF}qR^_+9SugZMMoGl5_jk{IH zn(-6+z_CE#Lq%t;1|o-*+rr0&y9lEKU4D=Nnb(q&53mnYZ=&FO0%z2H`Qb}6b;%1BP>gFlp9Vzy&K5j~(IvD~f1X4rA1N8{;u|;2XQy^%h zIJEkh(tplineU=5&DCJcTnEPBLJRn);X)$N;JW5Dn6nmL8i#*(P+lm>opb7l`Y?4D)G@Y2S|WMpY$eZsOsh6}P4 z#qDP8y^+>lW#^gAv+L2jRc26wwEhy+3aV`_s@eRi%rQIG)y+Lj(Z4+5T14)W(=4P zF^m)$)@`RMGEYYh9TKTTE}uh+$Tv+Wg0QuOX=O7|cxbUm4Hz!70K!OU~7sYiE`PAf`gQCgJsAXR7eC*(@B_X31b|IviuB1QEZ@< zZKnv-ULzW~5smG(vBc3?8q@L!3lg;)C$ZCXHf#9=F%YK1dIwKF{46xgp{)67-{lG? zp?ZfKwz7BO6JQ+y+a06Xr0AY4I$$&A0YN z5VqAs$l#VWQLy1M_#$Hzfh#0oB&ZufLrd%6AV;qiD8Qf{Sj@L^!CaFIA8vzrbqf}N zm8~BSzBmO=spj+jXIMcn-|8P?czAltIO0bNl!PD6UAlO2e&yO#xMCGffJ-tliTF_{ zBd%=|1y3M=+yU@)k^e)-D$)vM)8D_6lL76C=2`B%#;a9ht_N9MtS5r#A4 z10nOxfj8U_cXv8=xuPA>TDSHM%xC6Dv&$P|Zkn=J8~U~6Vmjk4W><=tTuwXP-)k;c zm(fv6ExM=HXUxC69`l32L+I3EIcW`t)r(Bgxg2*U|NewHYhRUD?-}gb)jJ@VWcHaS z2lw|4Yf-D|t%t2MX|4=TRP5oBoba8YbLHLybU&@l_BIru&KkWT!cE>>LZR8cBXUs7 z*4M=tT=GZ=%hm=)f(rM3+lFk_>$b+4(~$sQ8STdjkmPM$kHcH7j#V(xvWOuKHV0Zi zbcGR?gl!_2H*fpuPOepUf+U&c{W62iJNx@tSzW)sKhtAAInp(Jjt;{Ey$&Oh>Iu*W uP2@6JJw~!|`wOHeFxs6%**%H^nJmfBZ>jUgJ?sBy0{b6&m6HGf diff --git a/lispusers/COMPARETEXT.LCOM b/lispusers/COMPARETEXT.LCOM index 69290287b54054cbaf2639c6eb7df38c7412e262..d0d55d13128a75378dadbed9e847e4d1c1fa7304 100644 GIT binary patch delta 684 zcmZuuJ#W)c6s-+PAOjx~1LKh=Iu!Xm$Bxq}Zu}e@9NV&=Wg0+gP(B(FB~?JGm^!i& zWn*SWNST2N(O-ZnegslSHm*q)RNioP&pG$rb9LW`{CobcxW~;sZ}?)5>zsqt_YG^m zZY*COD%SGb+y9EIBPFO>s9W6Rt51r(>MGCILVc!=8z>Iui@|UK4>nxkIe93(IFh?i zvZ}gstu@}ES1W^Zw_j=9EVJHG8K-J->&GKiRW3dcx|hqZ-KPXph3Gq#Qa`W#y!bLb zk1m(d`uFwQ%9&xJBV>}s-9#2ajW;>ksc@ty z!0iUwanyDsr3{%L=b;-BFc>WrVS?y z+kPHB&cI9^l5W82CeoneOEAth46_glPr|fOevd1%b{ZryPRR?D3(<;-z?D8sctI#a z=RkznZtVeh!-RH9pR7?SgEpPahLnP>Y;bJj2W|_h2x^i>wUR0zRZJaO ziLx>C0gy5?B3M~a#TQ_OZ@@{D0n|Gjo%1`-d(PMVWB$Il#~ZbF|5Z&eA;3kG@up$U zP7f4w_T}CDmvU5rVR6=&e^Ttb_CKNZCNrBt%wH`kV}{VCe0!R)Qz*k58bGM&UM83+9FR3(coA)6WQ^j5W+UDrHOhStwcJREFkIv zttf0c8H8ma^`bm*Lo&F9PU6I#Os)#^p>6*UD0-d94S_@ktCH)!T<~kGArMEYpV3?~ zXs%Ug48z27OP=&QUN-+-(Jq*duCt%|hZ4fnQACLgq1y=jkO*BWb`pnXgF%1VAHUJS8wRvqS&~LO*6{jd bay}Xlp;ZY8XvCLIFd2~GroO0cebD{_h3ll` diff --git a/lispusers/EXAMINEDEFS b/lispusers/EXAMINEDEFS index b24513ad..194e4d96 100644 --- a/lispusers/EXAMINEDEFS +++ b/lispusers/EXAMINEDEFS @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 1-Feb-2022 23:15:24"  -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>EXAMINEDEFS.;36 11920 +(FILECREATED "25-Feb-2022 18:04:08"  +{DSK}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" -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>EXAMINEDEFS.;35) + :PREVIOUS-DATE " 1-Feb-2022 23:15:24" +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>EXAMINEDEFS.;36) (PRETTYCOMPRINT EXAMINEDEFSCOMS) @@ -19,7 +19,8 @@ (DEFINEQ (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 18-Jan-2022 22:40 by rmk") (* ; "Edited 12-Jan-2022 17:29 by rmk") @@ -55,9 +56,15 @@ ELSEIF (GETDEF NAME TYPE SOURCE2) ELSE (ERROR NAME " not found on " SOURCE2))) (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 - (SETQ TITLE2 (OR SOURCE2 "File 2"))) + (SETQ TITLE2 (CL:IF (AND SOURCE2 (ILEQ (COUNT SOURCE2) + 5)) + SOURCE12 + "File 2"))) (SELECTQ (EDITMODE) (SEDIT:SEDIT (* ;; @@ -199,6 +206,6 @@ (FILESLOAD (SYSLOAD) COMPARETEXT) (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 diff --git a/lispusers/EXAMINEDEFS.LCOM b/lispusers/EXAMINEDEFS.LCOM index 143f98482c5d83875201d71d25654a2208af5cbe..a84a5563fa4c62b792fdb806323c37798b562e34 100644 GIT binary patch delta 1086 zcmZuwOK;Oa5XKFKP$8tE9!iDUkyW7tktn4b^y+~v2+hLC$MIBLNomsC_*rUNdK$k;O}YnjA5zadQnhssf2-*u zabS0Wn>}FcD4hiECC88b&d8O9JZ@c>Pjxxk!qqjoF}ps9N?!ac_4C%&=<&X!jbMn6HcTQgQ{~yJ_&reD3;;GT2wn0D?ok)PH^MR%55LUc;wdh8mat+EN zYB+AuYt%y#_<`qx$~5rneYA%V0=8H4tw2O#3G)gZeb=@k;F<^lE}q z(EdZ1VL;6*iU6-|Cv5>UC|FTs*_D10(fzp0jEjt!@)CM zgZX+GIi+P_ND7>CB?86?n7u22F$GN5stKUF`WL16VR|S*onbra9tfuO=Fo5109<~2 zJ;1R88CG`j;HX}xi;A!UEDZ pc3RsBn^4FEs5423U#G8K*Z43>n2s-fbE^qd#z#pGzohps`~fK`9Yp{D delta 966 zcmZuwOKTHR6m}9#r&SA4k@%nAn(!CIU!So)Vpjdj?${|Dt?=uSq|q6^Xw_Uded`T$vN~Et=-$b zi2<-G_SvpEcBcAblJzLr{_J#x-|c+X$TZTu^qa15dH%wKeEa6w|7bbRp8k8Qd+>EK z$?qO~5bg^D^Ha|K;`FAQkFPG>>o-z&y9eK5?@WJImVj9{Z$zPVY!Ma0y4P|nHv$DI zG0I%rmMaSQt*C9gme=+J&j(qR!1S8F5wM6YL?A1a`>ttllPJK)YDX5Uf{e8zj--L- zGk3@n0##+Om{aDACJVXGRSe=jP(nDLzX%k|APy}g#rs^$lI@1AfDK82R1h>hiv=TA zAQ}ZDiVU+p&fwC*M2}u$QE3dyl@T}y0U_F0KSA0F`G}0b@~{A_iNHa_h)dwq0jt@b z3rLe;X!?MN7Jr>_HX#7K*y{@Q-7$Oq?a2uQJfceiv>RxVgC-Vkaplan>Local>medley3.5>my-medley>lispusers>PSEUDOHOSTS.;136 25474 +(FILECREATED "24-Feb-2022 23:56:08"  +{DSK}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" -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>PSEUDOHOSTS.;135) + :PREVIOUS-DATE " 5-Feb-2022 08:23:53" +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>PSEUDOHOSTS.;136) (PRETTYCOMPRINT PSEUDOHOSTSCOMS) @@ -38,12 +38,18 @@ (PSEUDOHOST [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) (NULL PREFIX)) (SETQ PREFIX (CADR 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))) [IF PREFIX THEN (CL:WHEN (PSEUDOHOSTP HOST) (* ; @@ -121,11 +127,13 @@ HOST]) (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))) (CL:WHEN (AND DEV (TYPE? FDEV (FETCH (PHDEVICE TARGETDEV) OF DEV))) - (LIST HOST (FETCH (PHDEVICE PREFIX) - DEV)))]) + (LIST (FETCH (FDEV DEVICENAME) OF DEV) + (FETCH (PHDEVICE PREFIX) + DEV)))]) (PSEUDOHOSTS [LAMBDA NIL (* ; "Edited 17-Jan-2022 18:15 by rmk") @@ -470,12 +478,12 @@ (LOAD 'EXPORTS.ALL)) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1226 8796 (PSEUDOHOST 1236 . 6496) (PSEUDOHOSTP 6498 . 6848) (PSEUDOHOSTS 6850 . 7207) -(TARGETHOST 7209 . 7483) (TRUEFILENAME 7485 . 8172) (PSEUDOFILENAME 8174 . 8794)) (8824 16095 ( -EXPAND.PH 8834 . 10108) (CONTRACT.PH 10110 . 12775) (SLASHIT 12777 . 14345) (UNSLASHIT 14347 . 16093)) - (16096 22886 (OPENFILE.PH 16106 . 16667) (GETFILENAME.PH 16669 . 16958) (DIRECTORYNAMEP.PH 16960 . -17584) (CLOSEFILE.PH 17586 . 17940) (REOPENFILE.PH 17942 . 18507) (DELETEFILE.PH 18509 . 18793) ( -OPENP.PH 18795 . 18971) (UNREGISTERFILE.PH 18973 . 19278) (REGISTERFILE.PH 19280 . 19581) ( -GENERATEFILES.PH 19583 . 20623) (GETFILEINFO.PH 20625 . 20927) (SETFILEINFO.PH 20929 . 21128) ( -NEXTFILEFN.PH 21130 . 21672) (FILEINFOFN.PH 21674 . 21945) (RENAMEFILE.PH 21947 . 22884))))) + (FILEMAP (NIL (1239 9187 (PSEUDOHOST 1249 . 6724) (PSEUDOHOSTP 6726 . 7239) (PSEUDOHOSTS 7241 . 7598) +(TARGETHOST 7600 . 7874) (TRUEFILENAME 7876 . 8563) (PSEUDOFILENAME 8565 . 9185)) (9215 16486 ( +EXPAND.PH 9225 . 10499) (CONTRACT.PH 10501 . 13166) (SLASHIT 13168 . 14736) (UNSLASHIT 14738 . 16484)) + (16487 23277 (OPENFILE.PH 16497 . 17058) (GETFILENAME.PH 17060 . 17349) (DIRECTORYNAMEP.PH 17351 . +17975) (CLOSEFILE.PH 17977 . 18331) (REOPENFILE.PH 18333 . 18898) (DELETEFILE.PH 18900 . 19184) ( +OPENP.PH 19186 . 19362) (UNREGISTERFILE.PH 19364 . 19669) (REGISTERFILE.PH 19671 . 19972) ( +GENERATEFILES.PH 19974 . 21014) (GETFILEINFO.PH 21016 . 21318) (SETFILEINFO.PH 21320 . 21519) ( +NEXTFILEFN.PH 21521 . 22063) (FILEINFOFN.PH 22065 . 22336) (RENAMEFILE.PH 22338 . 23275))))) STOP diff --git a/lispusers/PSEUDOHOSTS.LCOM b/lispusers/PSEUDOHOSTS.LCOM index b9e679716876f0e971beb57e70afac13084d9cf6..482ceb3fceb167baec6f88b02971610cff55952a 100644 GIT binary patch delta 1261 zcmZuxPfyf96yF7-xE#bN9E`@7A_Bi`mcDmc_Zl|_g{v;d};XnW-=)nZc z`VlniNxp#>6Y(2(@|&1=;S;EDx(h5wFK_1kpWpkvetGh>_F?HZW#wRFtxR=Fff`lQ zs_OjX)=HPpfkyb5jaXIYR0-9fw6?eL;?>UX=Jv)qY`opwdp%QyI29dVHe{N?=1b6m zPOAmO;gw27gZ1ZcFyykdjy6}C4Z@c265(dThe_?y#`eQI9H_}H6RKXrjp`yTXA)+E zD1}mQ;@;H698}{(EQYd^mVHdsbBoV<#>nrY=-nT^`(S(j_;YQ0q*TCft?<6K^EW?k zzdJsxZSDLSSNbD5IzH018Tg54%S8bub70jMK^O@iQ+uc}oHHviV6`r?z9~p#J966s znBxqg5(DELQki7HOdX=Ef$b-r^wH74_;cB*V?j6SLxEG_28bk)2~b9^B7EzqLSQLEG5*ZF{5M&ydNI9Hpa1>rkre`h)i617y%Ve^m29Bw^ zSdLmJ%_(J`9^XBjiaI(RTp3juWh=3mKEQ=T3Ps^E{vbHgB|#=pkMj4PVJwXyL zNPh(gwQ~zWnEMu_m^$DvEM%|^S|@5oaw&q$O%SKtr~$!s(H<*lfHseklfJZg@6#B0 xNQ;F+v9`IMZ|Kcpp|SpL`l{O2pY(?k-zOXW>qzg{*i4BHhHS8-8`lq~{sHVzHP!$C delta 1132 zcmZuw&1%$8811xDXhp$IQRw23QfQHx=Kds;45Cewn@*gW+;EezEfk@(vnbeFs)%4= zUcoZ%d;>Rv^$lG494>tczhtJhEoSrGocsNpobTk@`qyWlwno2e3+G2$Lw6MxSUn!> z*SXC(IByBovTY0V`=^6fZ;nn5Uk?s2_;7OicDV($ods#s$l5qOh86d_U0knjG#VBT z_TEv&|GK)?>ikNabX90nP^btN(RkSgcVttd6}E$PQ|0wSV=%wJ7gMJqGvMWXw8 zJ)%lj!mdBxJ05eky_Vy(q<8)?sX3!y`cLiQs6MlJ@qT7{ddPi5M)mXy1;>`yjZ~bZ zDxzkgg7oFpt#m!?ZmME@6&u}4gC3BJT!yJ1Icgqn}>Bv8IQ9Jq&UM))XieE4jpp z>PBFWk5H#!P=HB}yfB&0!MKN>>TQ5A?*=Vq``5PS`~SuaL0_K*Vdt_xT)G{Pb>*$8 z(!ZtxB)j&Ofo4zYxInKH6uL)?cDRk0)P%#>_#m6j$$_-UhF7Wvw#}N5Vv;YZ@CnV3 zScCALaf$G3n28KsRXR{K8FE#W?2|Os736Zz3U5G;AShLaY*XTSl_w?4P;Dl8p-hQZ zpm0bWa~tI@bf(g*N+Ft&>Z)<83b8$+RVG}v;iPfc)p<3oOyRzbC^0H5wAm^5SheEb zkX>>u!78)Kt65jAq=U0NGo^^dPNtU5$R{Lqnrwslf?Qz8ARbvb?|_kgONWANxS^vR zc)Y?%@(L!`l#%vAPUNuqX`_?strSIINV4jZ{#kOn^^~IYV69OU?l^KWnxA7!k84v? owe`b;yHoT$s7kaplan>Local>medley3.5>my-medley>lispusers>comparetext.;115 46109 +(FILECREATED "25-Feb-2022 14:36:43"  +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>comparetext.;116 46252 :CHANGES-TO (FNS COMPARETEXT.WINDOW) - :PREVIOUS-DATE "18-Feb-2022 17:05:22" -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>comparetext.;114) + :PREVIOUS-DATE "19-Feb-2022 12:01:45" +{DSK}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]) (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 23-Jan-2022 18:18 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] (SETQ GRAPHREGION (GRAPHREGION GRAPH)) - (SETQ WIDTH (IPLUS (TIMES 2 WBorder) - (FETCH (REGION WIDTH) OF GRAPHREGION))) + [SETQ WIDTH (IMIN SCREENWIDTH (IPLUS (TIMES 2 WBorder) + (FETCH (REGION WIDTH) OF GRAPHREGION] [SETQ HEIGHT (IMIN 200 (IPLUS (FETCH (REGION HEIGHT) OF GRAPHREGION) (ITIMES 2 (FONTHEIGHT DEFAULTFONT] (SETQ REGION @@ -736,12 +737,12 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation. ) (PUTPROPS COMPARETEXT COPYRIGHT ("Xerox Corporation" 1984 1985 1993 1998)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1344 38729 (COMPARETEXT 1354 . 2854) (COMPARETEXT.WINDOW 2856 . 6214) ( -COMPARETEXT.TEXTOBJ 6216 . 8924) (COMPARETEXT.SETSEL 8926 . 9716) (CHUNKNODELABEL 9718 . 10839) ( -IMCOMPARE.BOXNODE 10841 . 11608) (IMCOMPARE.CHUNKS 11610 . 15986) (IMCOMPARE.COLLECT.HASH.CHUNKS 15988 - . 18905) (IMCOMPARE.DISPLAYGRAPH 18907 . 26750) (IMCOMPARE.HASH 26752 . 30939) ( -IMCOMPARE.MERGE.CONNECTED.CHUNKS 30941 . 34437) (IMCOMPARE.MERGE.UNCONNECTED.CHUNKS 34439 . 36394) ( -IMCOMPARE.SHOW.DIST 36396 . 36842) (IMCOMPARE.UPDATE.SYMBOL.TABLE 36844 . 38727)) (38730 44887 ( -IMCOMPARE.LEFTBUTTONFN 38740 . 41317) (IMCOMPARE.MIDDLEBUTTONFN 41319 . 44435) (IMCOMPARE.COPYBUTTONFN - 44437 . 44885)) (44940 45631 (TAIL1 44950 . 45304) (TAIL2 45306 . 45629))))) + (FILEMAP (NIL (1344 38872 (COMPARETEXT 1354 . 2854) (COMPARETEXT.WINDOW 2856 . 6357) ( +COMPARETEXT.TEXTOBJ 6359 . 9067) (COMPARETEXT.SETSEL 9069 . 9859) (CHUNKNODELABEL 9861 . 10982) ( +IMCOMPARE.BOXNODE 10984 . 11751) (IMCOMPARE.CHUNKS 11753 . 16129) (IMCOMPARE.COLLECT.HASH.CHUNKS 16131 + . 19048) (IMCOMPARE.DISPLAYGRAPH 19050 . 26893) (IMCOMPARE.HASH 26895 . 31082) ( +IMCOMPARE.MERGE.CONNECTED.CHUNKS 31084 . 34580) (IMCOMPARE.MERGE.UNCONNECTED.CHUNKS 34582 . 36537) ( +IMCOMPARE.SHOW.DIST 36539 . 36985) (IMCOMPARE.UPDATE.SYMBOL.TABLE 36987 . 38870)) (38873 45030 ( +IMCOMPARE.LEFTBUTTONFN 38883 . 41460) (IMCOMPARE.MIDDLEBUTTONFN 41462 . 44578) (IMCOMPARE.COPYBUTTONFN + 44580 . 45028)) (45083 45774 (TAIL1 45093 . 45447) (TAIL2 45449 . 45772))))) STOP