Further cleanup of comparison functions
Mostly for cosmetics or convenience, a few glitches
This commit is contained in:
rmkaplan
parent
ab8da79d30
commit
d3b1c6a3b4
@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "18-Feb-2022 17:05:27"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;189 119161
|
||||
(FILECREATED "25-Feb-2022 21:30:55"
|
||||
{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"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;188)
|
||||
:PREVIOUS-DATE "24-Feb-2022 21:13:32"
|
||||
{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.")
|
||||
|
||||
(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
|
||||
|
||||
Binary file not shown.
@ -1,12 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "28-Jan-2022 18:22:40"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>COMPARESOURCES.;118 41270
|
||||
(FILECREATED "25-Feb-2022 18:02:24"
|
||||
{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"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>COMPARESOURCES.;116)
|
||||
:PREVIOUS-DATE "28-Jan-2022 18:22:40"
|
||||
{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
|
||||
\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
|
||||
|
||||
Binary file not shown.
Binary file not shown.
@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 1-Feb-2022 23:15:24"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>EXAMINEDEFS.;36 11920
|
||||
(FILECREATED "25-Feb-2022 18:04:08"
|
||||
{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"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>EXAMINEDEFS.;35)
|
||||
:PREVIOUS-DATE " 1-Feb-2022 23:15:24"
|
||||
{DSK}<Users>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
|
||||
|
||||
Binary file not shown.
@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 5-Feb-2022 08:23:53"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>PSEUDOHOSTS.;136 25474
|
||||
(FILECREATED "24-Feb-2022 23:56:08"
|
||||
{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"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>PSEUDOHOSTS.;135)
|
||||
:PREVIOUS-DATE " 5-Feb-2022 08:23:53"
|
||||
{DSK}<Users>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
|
||||
|
||||
Binary file not shown.
@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "19-Feb-2022 12:01:45"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>comparetext.;115 46109
|
||||
(FILECREATED "25-Feb-2022 14:36:43"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>comparetext.;116 46252
|
||||
|
||||
:CHANGES-TO (FNS COMPARETEXT.WINDOW)
|
||||
|
||||
:PREVIOUS-DATE "18-Feb-2022 17:05:22"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>comparetext.;114)
|
||||
:PREVIOUS-DATE "19-Feb-2022 12:01:45"
|
||||
{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])
|
||||
|
||||
(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
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user