From b791bff0708b968dd576dfbed4506fff8be3f282 Mon Sep 17 00:00:00 2001 From: rmkaplan <69548581+rmkaplan@users.noreply.github.com> Date: Thu, 27 Jan 2022 22:32:49 -0800 Subject: [PATCH] Rmk19: Updates and remaining components for managing comparisons and interactions between git and Medley (#658) * PSEUDOHOSTS: Overlay a file system at the end of a path in another file system New package, please look through it. * REGIONMANAGER: added RELCREATEPOSITION, allow for arguments to be spread If the WIDTH argument looks like a list of arguments, the arguments are spread out. Means that a relative region can be passed through intermediate functions. * EXAMINEDEFS: More control over regions and windows Examination windows are returned so that callers can manipulate them * TEDIT-PF-SEE: tf respects reader environment and bold faces of DEFUN and DEFMACRO names * COMPAREDIRECTORIES: refactored for more flexibility and easier maintenance Also, based on SPY, made more internal operations work on streams that are located and created once, rather than on file Added CDMERGE to merge CDVALUES for different subdirectories, to permit scrolling of all differences in a single browser window * COMPARESOURCES: Region for CS browser is passed through, window is returned Also tried to eliminate mismatching of simple edit timestamps * COMPARETEXT: Files can be input streams, region is passed in, window is returned * COMPAREDIRECTORIES again: Fixed a promptwindow bug * GITFNS: New package for comparing and copying back and forth from My Medley to the git clone --- lispusers/COMPAREDIRECTORIES | 722 +++++++++++------- lispusers/COMPAREDIRECTORIES.LCOM | Bin 34120 -> 37443 bytes lispusers/COMPAREDIRECTORIES.TEDIT | 13 +- lispusers/COMPARESOURCES | 161 ++-- lispusers/COMPARESOURCES.LCOM | Bin 17008 -> 17248 bytes lispusers/COMPARETEXT.LCOM | Bin 11615 -> 11940 bytes lispusers/COMPARETEXT.TEDIT | Bin 6467 -> 6618 bytes lispusers/EXAMINEDEFS | 169 ++-- lispusers/EXAMINEDEFS.LCOM | Bin 2345 -> 3625 bytes lispusers/EXAMINEDEFS.TEDIT | Bin 4166 -> 4957 bytes lispusers/GITFNS | 1143 ++++++++++++++++++++++++++++ lispusers/GITFNS.LCOM | Bin 0 -> 27253 bytes lispusers/GITFNS.TEDIT | Bin 0 -> 11034 bytes lispusers/PSEUDOHOSTS | 438 +++++++++++ lispusers/PSEUDOHOSTS.LCOM | Bin 0 -> 7525 bytes lispusers/PSEUDOHOSTS.TEDIT | Bin 0 -> 5636 bytes lispusers/REGIONMANAGER | 206 ++--- lispusers/REGIONMANAGER.LCOM | Bin 7392 -> 7770 bytes lispusers/REGIONMANAGER.TEDIT | 6 +- lispusers/TEDIT-PF-SEE | 43 +- lispusers/TEDIT-PF-SEE.LCOM | Bin 3547 -> 3878 bytes lispusers/comparetext | 197 ++--- 22 files changed, 2509 insertions(+), 589 deletions(-) create mode 100644 lispusers/GITFNS create mode 100644 lispusers/GITFNS.LCOM create mode 100644 lispusers/GITFNS.TEDIT create mode 100644 lispusers/PSEUDOHOSTS create mode 100644 lispusers/PSEUDOHOSTS.LCOM create mode 100644 lispusers/PSEUDOHOSTS.TEDIT diff --git a/lispusers/COMPAREDIRECTORIES b/lispusers/COMPAREDIRECTORIES index ed76d956..5f201f88 100644 --- a/lispusers/COMPAREDIRECTORIES +++ b/lispusers/COMPAREDIRECTORIES @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "30-Dec-2021 18:22:13"  -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;116 100755 +(FILECREATED "27-Jan-2022 17:47:36"  +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;160 112621 - :CHANGES-TO (FNS CD-MENUFN) + :CHANGES-TO (FNS CD.COMMANDSELECTEDFN) - :PREVIOUS-DATE "25-Dec-2021 12:59:47" -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;114) + :PREVIOUS-DATE "26-Jan-2022 15:33:55" +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;159) (* ; " @@ -19,11 +19,12 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp ( (* ;; "Compare the contents of two directories.") - (FNS COMPAREDIRECTORIES COMPAREDIRECTORIES.INFOS COMPAREDIRECTORIES.INFOS.TYPE MATCHNAME - CD.INSURECDVALUE CD.UPDATEWIDTHS) + (FNS COMPAREDIRECTORIES COMPAREDIRECTORIES.INFOS CDENTRIES.SELECT + COMPAREDIRECTORIES.INFOS.TYPE MATCHNAME CD.INSURECDVALUE CD.UPDATEWIDTHS) (FNS CDFILES CDFILES.MATCH CDFILES.PATS) - (FNS CDPRINT CDPRINT.LINE CDPRINT.MAXWIDTHS CDPRINT.COLHEADERS CDPRINT.COLUMNS CDTEDIT) - (FNS CDMAP CDENTRY CDSUBSET) + (FNS CDPRINT CDPRINT.HEADER CDPRINT.LINE CDPRINT.MAXWIDTHS CDPRINT.COLHEADERS CDPRINT.COLUMNS + CDTEDIT) + (FNS CDMAP CDENTRY CDSUBSET CDMERGE CDMERGE.COMMON) (FNS BINCOMP EOLTYPE EOLTYPE.SHOW) (RECORDS CDVALUE CDENTRY CDINFO CDMAXNCHARS) @@ -63,13 +64,10 @@ 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 23-Dec-2021 18:59 by rmk") - (* ; "Edited 19-Dec-2021 20:07 by rmk") - (* ; "Edited 30-Nov-2021 13:51 by rmk:") - (* ; "Edited 23-Nov-2021 12:57 by rmk:") - (* ; "Edited 6-Nov-2021 12:08 by rmk:") - (* ; "Edited 31-Oct-2021 11:01 by rmk:") - (* ; "Edited 7-Jan-2021 23:21 by rmk:") + FIXDIRECTORYDATES) (* ; "Edited 26-Jan-2022 13:33 by rmk") + (* ; "Edited 4-Jan-2022 12:09 by rmk") + (* ; "Edited 31-Oct-2021 11:01 by rmk:") + (* ; "Edited 7-Jan-2021 23:21 by rmk:") (* ;; "Compare the contents of two directories, e.g., for change-control purposes. Compares files matching FILEPATTERN (or *.*;) on DIR1 and DIR2, listing which is newer, or when one is not found on the other. If SELECT is or contains SAME/=, BEFORE/<, AFTER/>, then files where DIR1 is the same as, earlier than, or later than DIR2 are selected. SELECT= NIL is the same as (< >), T is the same as (< > =). Also allows selection based on file-length criteria.") @@ -96,8 +94,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 COMPAREDATE DEPTH1 DEPTH2 CDVALUE) - [SETQ COMPAREDATE (INTERSECTION SELECT '(< > =] + (PROG (INFOS1 INFOS2 CANDIDATES CDENTRIES DEPTH1 DEPTH2 CDVALUE (DATE (DATE))) (* ;; "DIRECTORYNAME here to get unrelativized specifications for header.") @@ -117,8 +114,8 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp (PRINTOUT T "Fixing directory dates" T) (FIX-DIRECTORY-DATES DIR1) (FIX-DIRECTORY-DATES DIR2)) - (PRINTOUT T "Comparing " DIR1 6 "vs. " DIR2 T "as of " (DATE) - " selecting " SELECT " ... ") + (CDPRINT.HEADER DIR1 DIR2 SELECT DATE T) + (PRINTOUT T " ... ") (SETQ INFOS1 (COMPAREDIRECTORIES.INFOS (CDFILES DIR1 INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH1) USEDIRECTORYDATE DIR1)) @@ -128,7 +125,7 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp (SETQ CDVALUE (CREATE CDVALUE CDDIR1 _ DIR1 CDDIR2 _ DIR2 - CDCOMPAREDATE _ (DATE) + CDCOMPAREDATE _ DATE CDSELECT _ SELECT)) (CL:UNLESS (OR INFOS2 INFOS1) (RETURN CDVALUE)) @@ -166,58 +163,7 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp (* ;; "Do the SELECT filtering and insert the date relation.") - [SETQ CDENTRIES - (for C MATCHNAME INFO1 INFO2 IDATE1 IDATE2 DATEREL BINCOMP in CANDIDATES - eachtime (SETQ MATCHNAME (pop C)) - (SETQ INFO1 (pop C)) - (SETQ INFO2 (pop C)) - (if (AND INFO1 INFO2) - then (SETQ IDATE1 (IDATE (fetch DATE of INFO1))) - (SETQ IDATE2 (IDATE (fetch DATE of INFO2))) - (SETQ DATEREL (if (IGREATERP IDATE1 IDATE2) - then '> - elseif (ILESSP IDATE1 IDATE2) - then '< - else '=)) - else - (* ;; "Just for printing--no comparison") - - (SETQ DATEREL '*)) - when (if (AND INFO1 INFO2) - then (CL:WHEN (OR (NULL COMPAREDATE) - (SELECTQ DATEREL - (> (MEMB '> SELECT)) - (< (MEMB '< SELECT)) - (= (MEMB '= SELECT)) - (SHOULDNT))) - (SETQ BINCOMP (BINCOMP (fetch (CDINFO FULLNAME) OF INFO1) - (fetch (CDINFO FULLNAME) OF INFO2) - T - (fetch (CDINFO EOL) OF INFO1) - (fetch (CDINFO EOL) OF INFO2))) - - (* ;; "We want the ~= test to reflect exact byte equivalence, including the same EOL. We use the BINCOMP value below to indicate EOL differences, so we check it here.") - - [NOT (AND (MEMB '~= SELECT) - BINCOMP - (EQ (fetch (CDINFO EOL) OF INFO1) - (fetch (CDINFO EOL) OF INFO2]) - elseif INFO1 - then - (* ;; "OK if INFO2 is missing?") - - (MEMB '*- SELECT) - 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] + (SETQ CDENTRIES (CDENTRIES.SELECT CANDIDATES SELECT)) (PRINTOUT T (LENGTH CDENTRIES) " entries" T) (REPLACE CDENTRIES OF CDVALUE WITH CDENTRIES) @@ -227,37 +173,118 @@ 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 23-Dec-2021 18:59 by rmk") + [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:") (* ;; "Value is a list of CDINFOS with the match-name consed on to the front") - (FOR FULLNAME TYPE LDATE (STARTPOS _ (ADD1 (NCHARS DIR))) IN FILES + (FOR FULLNAME TYPE LDATE STREAM (STARTPOS _ (ADD1 (NCHARS DIR))) IN FILES COLLECT (* ;; "GDATE/IDATE in case Y2K") - - (SETQ LDATE (OR (FILEDATE FULLNAME T) - (FILEDATE FULLNAME))) (* ; + (* ;  "Is it a Lisp file? Get it's internal filecreated date. ") - (CONS (MATCHNAME FULLNAME STARTPOS) - (CREATE CDINFO - FULLNAME _ FULLNAME - DATE _ [GDATE (IDATE (IF USEDIRECTORYDATE - THEN (GETFILEINFO FULLNAME 'CREATIONDATE) - ELSEIF (OR LDATE (GETFILEINFO FULLNAME - 'CREATIONDATE] - LENGTH _ (GETFILEINFO FULLNAME 'LENGTH) - AUTHOR _ (GETFILEINFO FULLNAME 'AUTHOR) - TYPE _ (COMPAREDIRECTORIES.INFOS.TYPE FULLNAME LDATE) - EOL _ (EOLTYPE FULLNAME]) + (SETQ STREAM (OPENSTREAM FULLNAME 'INPUT)) (* ; + "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) + (CREATE CDINFO + FULLNAME _ FULLNAME + DATE _ (GDATE (IDATE (IF (OR USEDIRECTORYDATE (NULL LDATE)) + THEN (GETFILEINFO STREAM 'CREATIONDATE) + ELSE (SETFILEINFO STREAM 'CREATIONDATE LDATE) + LDATE))) + LENGTH _ (GETFILEINFO STREAM 'LENGTH) + AUTHOR _ (GETFILEINFO STREAM 'AUTHOR) + TYPE _ (COMPAREDIRECTORIES.INFOS.TYPE STREAM LDATE) + EOL _ (EOLTYPE STREAM))) + (CLOSEF? STREAM]) + +(CDENTRIES.SELECT + [LAMBDA (CANDIDATES SELECT) (* ; "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)) + (if (AND INFO1 INFO2) + then (SETQ IDATE1 (IDATE (fetch DATE of INFO1))) + (SETQ IDATE2 (IDATE (fetch DATE of INFO2))) + (SETQ DATEREL (if (IGREATERP IDATE1 IDATE2) + then '> + elseif (ILESSP IDATE1 IDATE2) + then '< + else '=)) + else + (* ;; "Just for printing--no comparison") + + (SETQ DATEREL '*)) + when (if (AND INFO1 INFO2) + then (CL:WHEN (OR (NULL COMPAREDATE) + (SELECTQ DATEREL + (> (MEMB '> COMPAREDATE)) + (< (MEMB '< COMPAREDATE)) + (= (MEMB '= COMPAREDATE)) + (SHOULDNT))) + (SETQ BINCOMP (BINCOMP (fetch (CDINFO FULLNAME) OF INFO1) + (fetch (CDINFO FULLNAME) OF INFO2) + T + (fetch (CDINFO EOL) OF INFO1) + (fetch (CDINFO EOL) OF INFO2))) + (CL:WHEN (EQ T BINCOMP) + + (* ;; "Byte-equivalent files with different dates. Presumably the earlier date is more accurate, move back the date of the later file and make DATEREL be =. Perhaps we should do this even if there is only an EOL difference (BINCOMP non-NIL).;; Byte-equivalent files with different dates. Presumably the earlier date is more accurate, move back the date of the earlier file and make DATEREL be =. Perhaps we should do this even if there is only an EOL difference (BINCOMP non-NIL). ") + + (* ;; "We do this even if FIXDIRECTORYDATES is false, that addresses a property of individual Lisp source files.") + + (SELECTQ DATEREL + (> (SETFILEINFO (FETCH (CDINFO FULLNAME) OF INFO1) + 'CREATIONDATE + (REPLACE (CDINFO DATE) OF INFO1 WITH (FETCH (CDINFO DATE) + OF INFO2)))) + (< (SETFILEINFO (FETCH (CDINFO FULLNAME) OF INFO2) + 'CREATIONDATE + (REPLACE (CDINFO DATE) OF INFO2 WITH (FETCH (CDINFO DATE) + OF INFO1)))) + NIL) + (SETQ DATEREL '=)) + + (* ;; "We want the ~= test to reflect exact byte equivalence, including the same EOL. We use the BINCOMP value below to indicate EOL differences, so we check it here.") + + [NOT (AND (MEMB '~= SELECT) + BINCOMP + (EQ (fetch (CDINFO EOL) OF INFO1) + (fetch (CDINFO EOL) OF INFO2]) + elseif INFO1 + then + (* ;; "OK if INFO2 is missing?") + + (MEMB '*- SELECT) + 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]) (COMPAREDIRECTORIES.INFOS.TYPE - [LAMBDA (FULLNAME LDATE) (* ; "Edited 12-Dec-2021 22:50 by rmk") - (IF (OR LDATE (FILEDATE FULLNAME T) - (FILEDATE FULLNAME)) + [LAMBDA (FULLNAME LDATE) (* ; "Edited 4-Jan-2022 13:10 by rmk") + (* ; "Edited 12-Dec-2021 22:50 by rmk") + (IF LDATE THEN (CL:IF (MEMB (FILENAMEFIELD FULLNAME 'EXTENSION) *COMPILED-EXTENSIONS*) 'COMPILED @@ -318,9 +345,12 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp (DEFINEQ (CDFILES - [LAMBDA (DIR INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH)(* ; "Edited 23-Dec-2021 22:49 by rmk") - (* ; "Edited 6-Nov-2021 12:08 by rmk:") - (* ; "Edited 16-Oct-2020 13:42 by rmk:") + [LAMBDA (DIR INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH)(* ; "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") + (* ; "Edited 6-Nov-2021 12:08 by rmk:") + (* ; "Edited 16-Oct-2020 13:42 by rmk:") (* ;; "Returns a list of fullnames for files that satisfy the criteria. We generate all candidates that match INCLUDEDFILES but not EXCLUDEDFILES in DIR.") @@ -338,7 +368,7 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp (* ;; "EXCLUDEDFILES is a filepattern with * meaning everything, COM means *.LCOM and *.DFASL") - [SETQ EXCLUDEDFILES `(.DS_Store + [SETQ EXCLUDEDFILES `(*>.DS_Store ,@(MKLIST EXCLUDEDFILES] (CL:UNLESS (EQMEMB '.* INCLUDEDFILES) (* ;  "Excluded dot files unless specifically asked for") @@ -372,9 +402,14 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp (CL:UNLESS (OR (EQ SD '*) (EQ SD (CAR P))) (SETQ SD NIL)) FINALLY (CL:WHEN (EQ SD '*) - (SETQ SD "")) + (SETQ SD "")) + + (* ;; + "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 "<" TOPDIR ">" + (OR SD "")) 'NAME N 'EXTENSION E 'VERSION (CL:IF ALLVERSIONS '* @@ -387,48 +422,52 @@ 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))) - IN (DIRECTORY ENUMPAT) EACHTIME (CL:WHEN (DIRECTORYNAMEP FULLNAME) - (* ; "Skip directories") - (GO $$ITERATE)) - (SETQ UNPACK (UNPACKFILENAME FULLNAME)) - (SETQ NAME (LISTGET UNPACK 'NAME)) - (SETQ EXT (LISTGET UNPACK 'EXTENSION)) - (SETQ SUBDIR (SUBATOM (LISTGET UNPACK 'DIRECTORY) - STARTPOS)) - (CL:UNLESS NAME - (CL:WHEN EXT (* ; ".XY") - (SETQ NAME (PACK* "." EXT)) - (SETQ EXT NIL))) - (SETQ THISDEPTH (FOR I (CNT _ 1) FROM 1 - DO (SELCHARQ (NTHCHARCODE SUBDIR I) - ((> /) - (ADD CNT 1)) - (NIL (RETURN CNT)) - NIL))) + IN (DIRECTORY ENUMPAT NIL NIL (CL:IF ALLVERSIONS + "*" + "")) + EACHTIME (SETQ UNPACK (UNPACKFILENAME FULLNAME)) + (SETQ NAME (LISTGET UNPACK 'NAME)) + (SETQ EXT (LISTGET UNPACK 'EXTENSION)) + (CL:UNLESS NAME + (CL:WHEN EXT (* ; ".XY") + (SETQ NAME (PACK* "." EXT)) + (SETQ EXT NIL))) + (CL:UNLESS (OR NAME EXT) (* ; "Must have been a directory") + (GO $$ITERATE)) + (SETQ SUBDIR (SUBATOM (LISTGET UNPACK 'DIRECTORY) + STARTPOS)) + (SETQ THISDEPTH (FOR I (CNT _ 1) FROM 1 DO (SELCHARQ (NTHCHARCODE SUBDIR I) + ((> /) + (ADD CNT 1)) + (NIL (RETURN CNT)) + NIL))) WHEN (OR (NULL INCLUDES) (CDFILES.MATCH SUBDIR NAME EXT THISDEPTH INCLUDES)) UNLESS (CDFILES.MATCH SUBDIR NAME EXT THISDEPTH EXCLUDES) COLLECT FULLNAME]) (CDFILES.MATCH - [LAMBDA (SUBDIR NAME EXT THISDEPTH PATTERNS) (* ; "Edited 23-Dec-2021 21:47 by rmk") + [LAMBDA (SUBDIR NAME EXT THISDEPTH PATTERNS) (* ; "Edited 26-Jan-2022 15:33 by rmk") + (* ; "Edited 23-Dec-2021 21:47 by rmk") (* ;; "True if the components of the fullname match at least one of the patterns") - (THEREIS P IN PATTERNS SUCHTHAT (AND [OR (STRING.EQUAL NAME (CAR P)) + (THEREIS P IN PATTERNS SUCHTHAT (AND [OR (STRING.EQUAL NAME (CAR P) + FILEDIRCASEARRAY) (EQ '* (CAR P)) (AND (EQ (CHARCODE %.) (CHCON1 (CAR P))) - (EQ (EQ (CHARCODE %.) - (CHCON1 NAME))) + (EQ (CHARCODE %.) + (CHCON1 NAME)) (OR (STRING.EQUAL NAME (SUBATOM (CAR P) 2)) - (EQ (CHARCODE *1) + (EQ (CHARCODE *) (NTHCHARCODE (CAR P) 2] (OR (STRING.EQUAL EXT (CADR P)) (EQ '* (CADR P))) (OR (STRING.EQUAL SUBDIR (CADDR P)) - (NULL (CADDR P))) + (NULL (CADDR P)) + (EQ '* (CADDR P))) (ILEQ THISDEPTH (CADDDR P]) (CDFILES.PATS @@ -479,9 +518,10 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp (DEFINEQ (CDPRINT - [LAMBDA (CDVALUE FILE COLHEADINGS PRINTAUTHOR) (* ; "Edited 19-Dec-2021 20:10 by rmk") - (* ; "Edited 30-Nov-2021 20:59 by rmk:") - (* ; "Edited 13-Oct-2020 08:38 by rmk:") + [LAMBDA (CDVALUE FILE COLHEADINGS PRINTAUTHOR) (* ; "Edited 26-Jan-2022 13:43 by rmk") + (* ; "Edited 19-Dec-2021 20:10 by rmk") + (* ; "Edited 30-Nov-2021 20:59 by rmk:") + (* ; "Edited 13-Oct-2020 08:38 by rmk:") (* ;; "Typically CDVALUE will have a provdenance header. If not, we fake one up, at least for the directories and today's date.") @@ -502,11 +542,7 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp '(PROGN (CLOSEF? OLDVALUE]) (LINELENGTH 1000 STREAM) (* ; "Don't wrap") (CL:WHEN (FETCH (CDVALUE CDDIR1) OF CDVALUE) - (PRINTOUT STREAM "Comparing " (FETCH (CDVALUE CDDIR1) OF CDVALUE) - 6 "vs. " (FETCH (CDVALUE CDDIR2) OF CDVALUE) - T "as of " (FETCH (CDVALUE CDCOMPAREDATE) OF CDVALUE)) - (CL:WHEN (FETCH (CDVALUE CDSELECT) OF CDVALUE) - (PRINTOUT STREAM " selecting " (FETCH (CDVALUE CDSELECT) OF CDVALUE))) + (CDPRINT.HEADER CDVALUE STREAM) (PRINTOUT STREAM -2 (LENGTH (fetch CDENTRIES of CDVALUE)) " entries" T T)) (if (fetch CDENTRIES of CDVALUE) @@ -517,6 +553,27 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp else (PRINTOUT T "CDVALUE is empty" T)) (AND STREAM (CLOSEF? STREAM))))]) +(CDPRINT.HEADER + [LAMBDA (DIR1 DIR2 SELECT DATE STREAM) (* ; "Edited 26-Jan-2022 13:36 by rmk") + (CL:WHEN (LISTP DIR1) + + (* ;; "A CDVALUE") + + (CL:UNLESS STREAM (SETQ STREAM DIR2)) + (SETQ DIR2 (FETCH CDDIR2 OF DIR1)) + (SETQ SELECT (FETCH CDSELECT OF DIR1)) + (SETQ DATE (FETCH CDCOMPAREDATE OF DIR1)) + (SETQ DIR1 (FETCH CDDIR1 OF DIR1))) + (CL:WHEN DIR1 + (PRINTOUT STREAM "Comparing ") + (PRINTOUT STREAM DIR1 %# (CL:WHEN (IGREATERP (IPLUS (NCHARS DIR1) + (NCHARS DIR2)) + 70) + (TAB 5)) + " vs. " DIR2) + (PRINTOUT STREAM T 3 "as of " DATE) + (CL:WHEN SELECT (PRINTOUT STREAM " selecting " SELECT)))]) + (CDPRINT.LINE [LAMBDA (STREAM ENTRY PRINTAUTHOR DATE1POS ENDDATE1 NCHARSDIR1 NCHARSDIR2) (* ; "Edited 22-Nov-2021 22:38 by rmk:") @@ -752,6 +809,89 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp (SETQ INFO2 (FETCH INFO2 OF CDE)) (SETQ EQUIV (FETCH EQUIV OF CDE)) WHEN (APPLY* FN CDE) COLLECT CDE]) + +(CDMERGE + [LAMBDA (CDVALUES) (* ; "Edited 24-Jan-2022 17:01 by rmk") + + (* ;; "This merges a collection of CDVALUES on different directories into a single CDVALUE with the union of the CDENTRIES, provided that they have the same selection criteria. The merged directories will be the minimal common prefix of all of the entries on each side, and the residual of the directory will be packed onto all the names.") + + (IF (CDR CDVALUES) + THEN + [LET + (CDSELECTS) + + (* ;; "Group by selects") + + (FOR CDV TMP IN CDVALUES + DO (PUSH [CDR (OR (SASSOC (FETCH CDSELECT OF CDV) + CDSELECTS) + (CAR (PUSH CDSELECTS (CONS (FETCH CDSELECT OF CDV] + CDV)) + + (* ;; "For each group, find the longest common directory prefixes") + + (FOR CDS IDATE DIR1 DIR2 MERGEDENTRIES IN CDSELECTS + COLLECT (SETQ DIR1 (FETCH CDDIR1 OF (CADR CDS))) + (SETQ DIR2 (FETCH CDDIR2 OF (CADR CDS))) + [SETQ IDATE (IDATE (FETCH CDCOMPAREDATE OF (CADR CDS] + + (* ;; "Calculate the common directory prefixes and latest date") + + [FOR CDV IN (CDDR CDS) DO (SETQ DIR1 (CDMERGE.COMMON DIR1 (FETCH CDDIR1 + OF CDV))) + (SETQ DIR2 (CDMERGE.COMMON DIR2 (FETCH CDDIR2 + OF CDV))) + (CL:WHEN (IGREATERP IDATE (IDATE (FETCH CDCOMPAREDATE + OF CDV))) + (SETQ IDATE (IDATE (FETCH CDCOMPAREDATE OF CDV))))] + + (* ;; + "Merge the CDENTRIES with matchnames pulled back so that subdirectories show up") + + (SETQ MERGEDENTRIES + (SORT [FOR CDV NC1 _ (ADD1 (NCHARS DIR1)) + NC2 _ (ADD1 (NCHARS DIR2)) IN (CDR CDS) + JOIN (FOR CDE IN (FETCH CDENTRIES OF CDV) + COLLECT (CREATE CDENTRY + USING CDE MATCHNAME _ + (IF (FETCH INFO1 OF CDE) + THEN (MATCHNAME (FETCH (CDINFO FULLNAME) + OF (FETCH INFO1 + OF CDE)) + NC1) + ELSE (MATCHNAME (FETCH (CDINFO FULLNAME) + OF (FETCH INFO2 + OF CDE)) + NC2] + T)) + (CD.UPDATEWIDTHS (CREATE CDVALUE + CDDIR1 _ DIR1 + CDDIR2 _ DIR2 + CDCOMPAREDATE _ (GDATE IDATE) + CDSELECT _ (CAR CDS) + CDENTRIES _ MERGEDENTRIES] + ELSE CDVALUES]) + +(CDMERGE.COMMON + [LAMBDA (DIRX DIRY) (* ; "Edited 24-Jan-2022 16:40 by rmk") + + (* ;; + "Returns the longest common prefix of DIRX and DIRY, collapsing brackets, slashes, and case") + + (FOR I CX CY (LASTDIRPOS _ 1) FROM 1 EACHTIME (SETQ CX (NTHCHARCODE DIRX I)) + (SETQ CY (NTHCHARCODE DIRY I)) + (CL:WHEN (MEMB CX (CHARCODE (< > /))) + (SETQ CX (CHARCODE /))) + (CL:WHEN (MEMB CY (CHARCODE (< > /))) + (SETQ CY (CHARCODE /))) + (CL:WHEN (AND (EQ CX (CHARCODE /)) + (EQ CY (CHARCODE /))) + (SETQ LASTDIRPOS I)) + UNLESS [AND CX CY (OR (EQ CX CY) + (EQ (L-CASECODE CX) + (L-CASECODE CY] DO (RETURN (CL:IF (EQ I 1) + "" + (SUBSTRING DIRX 1 LASTDIRPOS))]) ) (DEFINEQ @@ -827,40 +967,51 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp FINALLY (RETURN (OR EOLDIFF T]))]) (EOLTYPE - [LAMBDA (FILE SHOWCONTEXT) (* ; "Edited 21-Feb-2021 20:34 by rmk:") + [LAMBDA (FILE SHOWCONTEXT) - (* ;; "Returns the EOLCONVENTION of FILE if it only sees one kind, NIL if it can't decide.") + (* ;; "Edited 4-Jan-2022 15:10 by rmk: Allow FILE to be an already open stream") - (* ;; "If SHOWCONTEXT, it is the number of bytes before and after an EOL inconsistency (e.g. seeing CR after having seen LF) that will be displayed on the TTY. The position of the inconsistency will be marked with ##.") + (* ;; "Edited 21-Feb-2021 20:34 by rmk:") + + (* ;; "Returns the EOLCONVENTION of FILE if it only sees one kind, NIL if it can't decide.") + + (* ;; "If SHOWCONTEXT, it is the number of bytes before and after an EOL inconsistency (e.g. seeing CR after having seen LF) that will be displayed on the TTY. The position of the inconsistency will be marked with ##.") (SELECTQ SHOWCONTEXT (NIL) (T (SETQ SHOWCONTEXT 100)) (CL:UNLESS (FIXP SHOWCONTEXT) (ERROR "SHOWCONTEXT must be an integer" SHOWCONTEXT))) - (CL:WITH-OPEN-FILE - (STREAM FILE :DIRECTION :INPUT) - (SETFILEINFO STREAM 'ENDOFSTREAMOP (FUNCTION NILL)) - (BIND EOLTYPE - DO (SELCHARQ (OR (\BIN STREAM) - (RETURN EOLTYPE)) - (CR (IF (EQ (CHARCODE LF) + (RESETLST + (LET (STREAM) + [IF (GETSTREAM FILE 'INPUT T) + THEN (SETQ STREAM FILE) + [RESETSAVE NIL `(PROGN (SETFILEPTR ,STREAM ,(GETFILEPTR STREAM)) + (STREAMPROP ,STREAM 'ENDOFSTREAMOP + ',(STREAMPROP STREAM 'ENDOFSTREAMOP] + (SETFILEPTR STREAM 0) + ELSE (RESETSAVE NIL `(CLOSEF? ,(SETQ STREAM (OPENSTREAM FILE 'INPUT] + (SETFILEINFO STREAM 'ENDOFSTREAMOP (FUNCTION NILL)) + (BIND EOLTYPE + DO (SELCHARQ (OR (\BIN STREAM) + (RETURN EOLTYPE)) + (CR (IF (EQ (CHARCODE LF) (\PEEKBIN STREAM T)) - THEN (\BIN STREAM) - (IF (MEMB EOLTYPE '(LF CR)) - THEN (CL:UNLESS (EOLTYPE.SHOW SHOWCONTEXT EOLTYPE - 'LF STREAM) - (RETURN NIL)) - ELSE (SETQ EOLTYPE 'CRLF)) - ELSEIF (MEMB EOLTYPE '(LF CRLF)) - THEN (CL:UNLESS (EOLTYPE.SHOW SHOWCONTEXT EOLTYPE 'CR STREAM) + THEN (\BIN STREAM) + (IF (MEMB EOLTYPE '(LF CR)) + THEN (CL:UNLESS (EOLTYPE.SHOW SHOWCONTEXT EOLTYPE + 'LF STREAM) + (RETURN NIL)) + ELSE (SETQ EOLTYPE 'CRLF)) + ELSEIF (MEMB EOLTYPE '(LF CRLF)) + THEN (CL:UNLESS (EOLTYPE.SHOW SHOWCONTEXT EOLTYPE 'CR STREAM) (RETURN NIL)) - ELSE (SETQ EOLTYPE 'CR))) - (LF (IF (MEMB EOLTYPE '(CR CRLF)) - THEN (CL:UNLESS (EOLTYPE.SHOW SHOWCONTEXT EOLTYPE 'LF STREAM) + ELSE (SETQ EOLTYPE 'CR))) + (LF (IF (MEMB EOLTYPE '(CR CRLF)) + THEN (CL:UNLESS (EOLTYPE.SHOW SHOWCONTEXT EOLTYPE 'LF STREAM) (RETURN NIL)) - ELSE (SETQ EOLTYPE 'LF))) - NIL]) + ELSE (SETQ EOLTYPE 'LF))) + NIL))))]) (EOLTYPE.SHOW [LAMBDA (SHOWCONTEXT OLDTYPE NEWTYPE STREAM) (* ; "Edited 21-Feb-2021 20:20 by rmk:") @@ -1435,18 +1586,16 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp (CDBROWSER [LAMBDA (CDVALUE TITLE COLHEADINGS BROWSERPROPS SEPARATEDIRECTIONS MENUITEMS) - (* ; "Edited 25-Dec-2021 12:50 by rmk") - (* ; "Edited 16-Dec-2021 11:51 by rmk") - (* ; "Edited 14-Dec-2021 21:41 by rmk") - (* ; "Edited 10-Dec-2021 21:38 by rmk") - (* ; "Edited 30-Nov-2021 15:03 by rmk:") - (* ; "Edited 29-Nov-2021 14:18 by rmk:") + + (* ;; "Edited 25-Jan-2022 13:05 by rmk: a table browser for the differences in CDVALUE.") (* ;; "Creates a table browser for the differences in CDVALUE.") (SETQ MENUITEMS (IF MENUITEMS THEN (FOR I IN MENUITEMS COLLECT (OR (LISTP I) (SASSOC I CDTABLEBROWSER.MENUITEMS) + (AND (STREQUAL I "") + "") (ERROR "UNKNOWN CDBROWSER MENU ITEM" I)) ) ELSE CDTABLEBROWSER.MENUITEMS)) @@ -1466,8 +1615,8 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp DEFAULTFONT] [SETQ REGION (GETREGION (PLUS TB.LEFT.MARGIN ITEMWIDTH (TIMES 2 WBorder) MENUWIDTH) - (TIMES [IMIN 15 (IMAX (IPLUS 4 (LENGTH STRINGS)) - (ADD1 (LENGTH MENUITEMS] + (TIMES (IMAX (IMIN 15 (LENGTH STRINGS)) + (ADD1 (LENGTH MENUITEMS))) (FONTPROP DEFAULTFONT 'HEIGHT] (* ;; "Promptwindow seems to do its own thing, even if under construction. So we preshrink the main window.") @@ -1476,8 +1625,13 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp OF REGION) (FONTPROP DEFAULTFONT 'HEIGHT] - (SETQ WINDOW (CREATEW REGION (OR TITLE "Compare directories") + (SETQ WINDOW (CREATEW REGION (OR TITLE (CONCAT "Compare directories " (LENGTH + STRINGS) + " files")) NIL T)) + [WINDOWADDPROP WINDOW 'CLOSEFN (FUNCTION (LAMBDA (W) + (FOR W INSIDE (WINDOWPROP W 'SUBWINDOWS) + DO (CLOSEW (WFROMDS W] (WINDOWPROP WINDOW 'UNDERCONSTRUCTION T) (* ;; "TABLEBROWSER is odd: USERDATA is a single recognized property. But it allows for other unrecognized properties in the list, it pushes them on to a list USERPROPS...and then throws it away. So here I'm using USERDATA to hold the directory lengths so they can be stripped off for display. It may actually be better to have a field name in CDVALUE for all of the shared stuff in front of the entries, and keep it all.") @@ -1610,105 +1764,153 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp 'DON'T]) (CD.COMMANDSELECTEDFN - [LAMBDA (MENUITEM MENU KEY) (* ; "Edited 25-Dec-2021 11:20 by rmk") - (* ; "Edited 16-Dec-2021 13:45 by rmk") - (* ; "Edited 13-Dec-2021 17:13 by rmk") - (* ; "Edited 9-Dec-2021 21:36 by rmk") - (* ; "Edited 8-Dec-2021 11:27 by rmk") - (* ; "Edited 5-Dec-2021 13:28 by rmk") - (* ; "Edited 3-Dec-2021 00:21 by rmk:") - (* ; "Edited 29-Nov-2021 23:08 by rmk:") + [LAMBDA (MENUITEM MENU KEY) (* ; "Edited 27-Jan-2022 17:46 by rmk") + (* ; "Edited 10-Jan-2022 22:51 by rmk") + (* ; "Edited 25-Dec-2021 11:20 by rmk") (* ; "Edited 12-Jan-87 12:57 by bvm:") (* ;; "Cobbled from FB.COMMANDSELECTEDFN. But here we assume that the menu item is of the form (display-string FN . EXTRAS), we peel out the FN to apply, leave the rest alone.") (DECLARE (SPECVARS MENUITEM MENU KEY)) - (RESETLST - [LET* [(WINDOW (WINDOWPROP (WFROMMENU MENU) - 'MAINWINDOW)) - (PROMPTWINDOW (GETPROMPTWINDOW WINDOW)) - (CDBROWSER (WINDOWPROP WINDOW 'TABLEBROWSER)) - (USERDATA (TB.USERDATA CDBROWSER)) - (CDVALUE (LISTGET USERDATA 'CDVALUE)) - (FN (CADR (LISTP MENUITEM] - (DECLARE (SPECVARS WINDOW PROMPTWINDOW CDVALUE USERDATA)) - (GIVE.TTY.PROCESS PROMPTWINDOW) - (TTYDISPLAYSTREAM PROMPTWINDOW) (* ; "Pwindow") - (IF (EQ 0 (TB.NUMBER.OF.ITEMS CDBROWSER 'SELECTED)) - THEN (FLASHWINDOW PROMPTWINDOW) - (PRIN3 "Please make a selection" T) - ELSE (TB.MAP.SELECTED.ITEMS CDBROWSER - [FUNCTION (LAMBDA (CDBROWSER TBITEM) - (LET* ((CDENTRY (CADR (FETCH TIDATA OF TBITEM))) - (FILE1 (FETCH (CDINFO FULLNAME) - (FETCH (CDENTRY INFO1) OF CDENTRY))) - (FILE2 (FETCH (CDINFO FULLNAME) - (FETCH (CDENTRY INFO2) OF CDENTRY))) - (TYPE (FETCH (CDINFO TYPE) OF (FETCH (CDENTRY INFO1) - OF CDENTRY))) - (LABELS (APPLY* (OR (LISTGET USERDATA 'LABELFN) - (FUNCTION NILL)) - FILE1 FILE2 USERDATA)) - (LABEL1 (OR (CAR LABELS) - FILE1)) - (LABEL2 (OR (CADR LABELS) - FILE2))) - (DECLARE (SPECVARS . T)) + (CL:UNLESS (STREQUAL MENUITEM "") (* ; "For blank lines") + (RESETLST + [LET* [(WINDOW (WINDOWPROP (WFROMMENU MENU) + 'MAINWINDOW)) + (PWINDOW (GETPROMPTWINDOW WINDOW)) + (CDBROWSER (WINDOWPROP WINDOW 'TABLEBROWSER)) + (USERDATA (TB.USERDATA CDBROWSER)) + (CDVALUE (LISTGET USERDATA 'CDVALUE)) + (FN (CADR (LISTP MENUITEM] + (DECLARE (SPECVARS WINDOW PWINDOW CDVALUE USERDATA)) + (GIVE.TTY.PROCESS PWINDOW) + (TTYDISPLAYSTREAM PWINDOW) (* ; "Pwindow") + (COND + ((EQ 0 (TB.NUMBER.OF.ITEMS CDBROWSER 'SELECTED)) + (FLASHWINDOW PWINDOW) + (PRIN3 "Please make a selection" T)) + (T (TB.MAP.SELECTED.ITEMS + CDBROWSER + [FUNCTION (LAMBDA (CDBROWSER TBITEM) + (LET* ((CDENTRY (CADR (FETCH TIDATA OF TBITEM))) + (FILE1 (FETCH (CDINFO FULLNAME) + (FETCH (CDENTRY INFO1) OF CDENTRY))) + (FILE2 (FETCH (CDINFO FULLNAME) + (FETCH (CDENTRY INFO2) OF CDENTRY))) + (TYPE (FETCH (CDINFO TYPE) OF (FETCH (CDENTRY INFO1) + OF CDENTRY))) + (LABELS (APPLY* (OR (LISTGET USERDATA 'LABELFN) + (FUNCTION NILL)) + FILE1 FILE2 USERDATA)) + (LABEL1 (OR (CAR LABELS) + FILE1)) + (LABEL2 (OR (CADR LABELS) + FILE2))) + (DECLARE (SPECVARS . T)) (* ;; "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])]) + (CLEARW T) + (CL:FUNCALL FN TBITEM MENUITEM CDBROWSER KEY] + (FUNCTION NILL]))]) (CD-MENUFN - [LAMBDA (TBITEM MENUITEM CDBROWSER KEY) (* ; "Edited 30-Dec-2021 18:21 by rmk") - (* ; "Edited 20-Dec-2021 09:56 by rmk") - (* ; "Edited 16-Dec-2021 13:30 by rmk") - (* ; "Edited 13-Dec-2021 22:11 by rmk") - (* ; "Edited 10-Dec-2021 21:42 by rmk") - (* ; "Edited 9-Dec-2021 21:24 by rmk") + [LAMBDA (TBITEM MENUITEM CDBROWSER KEY) + + (* ;; "Edited 25-Jan-2022 10:19 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.") (* ;; "MENUITEM is of the form (display-atom . extrainfo). The selector for the selectq is either the CAR of the extrainfo or the display atom.") - (SELECTQ (OR (CADDR MENUITEM) - (CAR MENUITEM)) - (Compare (IF (AND FILE1 FILE2) - THEN (SELECTQ TYPE - (SOURCE (CSBROWSER FILE1 FILE2 NIL LABEL1 LABEL2)) - (COMPILED (PRIN3 "Cannot compare compiled files" T)) - ((TEXT TEDIT) - (* ;; + (LET + (SUBWINDOWS) + (CL:WHEN (MEMB (OR (CADDR MENUITEM) + (CAR MENUITEM)) + '(Compare See% right See% both See% left)) + (FOR W IN (WINDOWPROP WINDOW 'SUBWINDOWS) WHEN (OPENWP W) DO (CLOSEW W))) + (SELECTQ (OR (CADDR MENUITEM) + (CAR MENUITEM)) + (Compare (IF (AND FILE1 FILE2) + THEN [SETQ SUBWINDOWS + (SELECTQ TYPE + (SOURCE (CSBROWSER FILE1 FILE2 NIL LABEL1 LABEL2 + (RELCREATEREGION + [FIXR (TIMES 0.75 (FETCH (REGION WIDTH) + OF (WINDOWPROP WINDOW + 'REGION] + 200 + 'LEFT + 'TOP + `(,WINDOW 0.125) + (IPLUS (FETCH (REGION BOTTOM) + OF (WINDOWPROP WINDOW 'REGION)) + 20) + T))) + (COMPILED (FLASHWINDOW T) + (PRIN3 "Cannot compare compiled files" T)) + ((TEXT TEDIT) + (* ;;  "Works for TEDIT, but doesn't detect image object differences") - (COMPARETEXT FILE1 FILE2 'LINE NIL (LIST LABEL1 LABEL2))) - (PROGN (PRIN3 "Unable to compare, showing both" T) - (TEDIT-SEE-VERSIONS FILE1 FILE2 LABEL1 LABEL2))) - ELSE (PRIN3 "Only one file" T))) - (See% left (IF FILE1 - THEN (TEDIT-SEE FILE1 NIL NIL (CONCAT "SEE window for " LABEL1)) - ELSE (FLASHWINDOW T) - (PRIN3 "No file to print" T))) - (See% right (IF FILE2 - THEN (TEDIT-SEE FILE2 NIL NIL (CONCAT "SEE window for " LABEL2)) + (COMPARETEXT FILE1 FILE2 'LINE + (RELCREATEPOSITION `(,WINDOW 0.5) + (IPLUS (FETCH (REGION BOTTOM) + OF (WINDOWPROP WINDOW 'REGION)) + 20)) + (LIST LABEL1 LABEL2))) + (PROGN (FLASHWINDOW T) + (PRIN3 "Unable to compare, showing both" T) + (TEDIT-SEE-VERSIONS FILE1 FILE2 LABEL1 LABEL2] + ELSE (FLASHWINDOW T) + (PRIN3 "Only one file" T))) + (See% left (IF FILE1 + THEN (SETQ SUBWINDOWS (TEDIT-SEE FILE1 + (RELCREATEREGION + 700 700 'RIGHT 'TOP `(,WINDOW 0.5) + (IPLUS (FETCH (REGION BOTTOM) + OF (WINDOWPROP WINDOW 'REGION)) + -1) + T) + NIL + (CONCAT "SEE window for " LABEL1))) ELSE (FLASHWINDOW T) (PRIN3 "No file to print" T))) - (See% both (IF (AND FILE1 FILE2) - THEN (EXAMINEFILES FILE1 FILE2 LABEL1 LABEL2) - ELSE (PRIN3 "Only one file" T))) - (Copy% -> (LET [(DEST (COPYFILE FILE1 (PACKFILENAME 'VERSION NIL FILE2] - (PRIN3 (CL:IF DEST - (CONCAT "Copied to " DEST) - (CONCAT FILE2 " could not be copied")) - T))) - (Copy% <- (LET [(DEST (COPYFILE FILE2 (PACKFILENAME 'VERSION NIL FILE1] - (PRIN3 (CL:IF DEST - (CONCAT "Copied to " DEST) - (CONCAT FILE1 " could not be copied")) - T))) - (SHOULDNT]) + (See% right (IF FILE2 + THEN (SETQ SUBWINDOWS (TEDIT-SEE FILE2 + (RELCREATEREGION + 700 700 'LEFT 'TOP `(,WINDOW 0.5) + (IPLUS (FETCH (REGION BOTTOM) + OF (WINDOWPROP WINDOW 'REGION)) + -1) + T) + NIL + (CONCAT "SEE window for " LABEL2))) + ELSE (FLASHWINDOW T) + (PRIN3 "No file to print" T))) + (See% both (IF (AND FILE1 FILE2) + THEN (SETQ SUBWINDOWS (EXAMINEFILES FILE1 FILE2 LABEL1 LABEL2 + (RELCREATEREGION + 1400 700 'LEFT 'TOP `(,WINDOW 0.5 -701) + (IPLUS (FETCH (REGION BOTTOM) + OF (WINDOWPROP WINDOW 'REGION)) + -1) + T))) + ELSE (FLASHWINDOW T) + (PRIN3 "Only one file" T))) + (Copy% -> (LET [(DEST (COPYFILE FILE1 (PACKFILENAME 'VERSION NIL FILE2] + (PRIN3 (CL:IF DEST + (CONCAT "Copied to " DEST) + (PROGN (FLASHWINDOW T) + (CONCAT FILE2 " could not be copied"))) + T))) + (Copy% <- (LET [(DEST (COPYFILE FILE2 (PACKFILENAME 'VERSION NIL FILE1] + (PRIN3 (CL:IF DEST + (CONCAT "Copied to " DEST) + (PROGN (FLASHWINDOW T) + (CONCAT FILE1 " could not be copied"))) + T))) + (SHOULDNT)) + (FOR W INSIDE SUBWINDOWS DO (WINDOWADDPROP WINDOW 'SUBWINDOWS (WFROMDS W]) ) (RPAQQ CDTABLEBROWSER.MENUITEMS ((Compare CD-MENUFN) @@ -1723,21 +1925,23 @@ 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 (2418 17067 (COMPAREDIRECTORIES 2428 . 12186) (COMPAREDIRECTORIES.INFOS 12188 . 13867) ( -COMPAREDIRECTORIES.INFOS.TYPE 13869 . 14451) (MATCHNAME 14453 . 14983) (CD.INSURECDVALUE 14985 . 16599 -) (CD.UPDATEWIDTHS 16601 . 17065)) (17068 26728 (CDFILES 17078 . 23061) (CDFILES.MATCH 23063 . 24449) -(CDFILES.PATS 24451 . 26726)) (26729 41174 (CDPRINT 26739 . 29343) (CDPRINT.LINE 29345 . 31901) ( -CDPRINT.MAXWIDTHS 31903 . 36018) (CDPRINT.COLHEADERS 36020 . 36658) (CDPRINT.COLUMNS 36660 . 40539) ( -CDTEDIT 40541 . 41172)) (41175 44371 (CDMAP 41185 . 42617) (CDENTRY 42619 . 42928) (CDSUBSET 42930 . -44369)) (44372 51313 (BINCOMP 44382 . 48671) (EOLTYPE 48673 . 50638) (EOLTYPE.SHOW 50640 . 51311)) ( -51841 65048 (FIND-UNCOMPILED-FILES 51851 . 55494) (FIND-UNSOURCED-FILES 55496 . 58305) ( -FIND-SOURCE-FILES 58307 . 60011) (FIND-COMPILED-FILES 60013 . 62091) (FIND-UNLOADED-FILES 62093 . -62837) (FIND-LOADED-FILES 62839 . 63393) (FIND-MULTICOMPILED-FILES 63395 . 65046)) (65049 73251 ( -CREATED-AS 65059 . 69856) (SOURCE-FOR-COMPILED-P 69858 . 72556) (COMPILE-SOURCE-DATE-DIFF 72558 . -73249)) (73252 83558 (FIX-DIRECTORY-DATES 73262 . 76255) (FIX-EQUIV-DATES 76257 . 77782) ( -COPY-COMPARED-FILES 77784 . 79605) (COPY-MISSING-FILES 79607 . 81764) (COMPILED-ON-SAME-SOURCE 81766 - . 83556)) (83752 91440 (CDBROWSER 83762 . 88335) (CDBROWSER.STRINGS 88337 . 91438)) (91602 92874 ( -CD.TABLEITEM 91612 . 91832) (CD.TABLEITEM.PRINTFN 91834 . 92033) (CD.TABLEITEM.COPYFN 92035 . 92629) ( -CDTABLEBROWSER.HEADING.REPAINTFN 92631 . 92872)) (92875 100220 (CDTABLEBROWSER.WHENSELECTEDFN 92885 . -93353) (CD.COMMANDSELECTEDFN 93355 . 97161) (CD-MENUFN 97163 . 100218))))) + (FILEMAP (NIL (2497 19012 (COMPAREDIRECTORIES 2507 . 8956) (COMPAREDIRECTORIES.INFOS 8958 . 11078) ( +CDENTRIES.SELECT 11080 . 15766) (COMPAREDIRECTORIES.INFOS.TYPE 15768 . 16396) (MATCHNAME 16398 . 16928 +) (CD.INSURECDVALUE 16930 . 18544) (CD.UPDATEWIDTHS 18546 . 19010)) (19013 29285 (CDFILES 19023 . +25379) (CDFILES.MATCH 25381 . 27006) (CDFILES.PATS 27008 . 29283)) (29286 44371 (CDPRINT 29296 . 31641 +) (CDPRINT.HEADER 31643 . 32540) (CDPRINT.LINE 32542 . 35098) (CDPRINT.MAXWIDTHS 35100 . 39215) ( +CDPRINT.COLHEADERS 39217 . 39855) (CDPRINT.COLUMNS 39857 . 43736) (CDTEDIT 43738 . 44369)) (44372 +52741 (CDMAP 44382 . 45814) (CDENTRY 45816 . 46125) (CDSUBSET 46127 . 47566) (CDMERGE 47568 . 51422) ( +CDMERGE.COMMON 51424 . 52739)) (52742 60280 (BINCOMP 52752 . 57041) (EOLTYPE 57043 . 59605) ( +EOLTYPE.SHOW 59607 . 60278)) (60808 74015 (FIND-UNCOMPILED-FILES 60818 . 64461) (FIND-UNSOURCED-FILES +64463 . 67272) (FIND-SOURCE-FILES 67274 . 68978) (FIND-COMPILED-FILES 68980 . 71058) ( +FIND-UNLOADED-FILES 71060 . 71804) (FIND-LOADED-FILES 71806 . 72360) (FIND-MULTICOMPILED-FILES 72362 + . 74013)) (74016 82218 (CREATED-AS 74026 . 78823) (SOURCE-FOR-COMPILED-P 78825 . 81523) ( +COMPILE-SOURCE-DATE-DIFF 81525 . 82216)) (82219 92525 (FIX-DIRECTORY-DATES 82229 . 85222) ( +FIX-EQUIV-DATES 85224 . 86749) (COPY-COMPARED-FILES 86751 . 88572) (COPY-MISSING-FILES 88574 . 90731) +(COMPILED-ON-SAME-SOURCE 90733 . 92523)) (92719 100458 (CDBROWSER 92729 . 97353) (CDBROWSER.STRINGS +97355 . 100456)) (100620 101892 (CD.TABLEITEM 100630 . 100850) (CD.TABLEITEM.PRINTFN 100852 . 101051) +(CD.TABLEITEM.COPYFN 101053 . 101647) (CDTABLEBROWSER.HEADING.REPAINTFN 101649 . 101890)) (101893 +112086 (CDTABLEBROWSER.WHENSELECTEDFN 101903 . 102371) (CD.COMMANDSELECTEDFN 102373 . 105764) ( +CD-MENUFN 105766 . 112084))))) STOP diff --git a/lispusers/COMPAREDIRECTORIES.LCOM b/lispusers/COMPAREDIRECTORIES.LCOM index 05661b70112c9980b68070d42fe3b01b622117b9..3abba64c37d846be6c5f6ef9d81c597b2dee3115 100644 GIT binary patch delta 9922 zcmb7KYj7Lab;be|ZP6wLk|ISiigXRzGRTM!b{9`ZQV0S|VMPE-wjw`mkln`tH~2$~bic_3{vY5JU|)9JXKX{OW1kN)Tkm1Nrf ziu;{&cS%5YGgESAareF-=X~co=kAYQ@P7Xd?-v#iYVpal=PyrcVNDZid@2&3(qk`O zTB*mv<07EN_6jw9N>5HjlYt&_;p*z68;@UETVJh;)u*mpy>|bUNM}N6E1yplG9@Et zq{~KTwjkCni@9o~s>L)_Or^7_!WpA9S++!QwovMMp9$H2qYMqUtw@bd>H1VON?m!QN!#=uw!iO< z$1+BtTr`c6m=|%8#)`}g=0UG9VHResl7?hdCRHROg39f{Ebb|KlF#a`Noq~rC+)GOkZ=pV1KxK;dEixTN@i2tBnmT`Cc`*AI(0r z-17RiUpPCk(pN3?r-rTjeA|oGv4I}ya*dx>-wgk*`0c;#4&37(wTAaosWtp)Xm%^* z=a=Q|XyY|y<+x(?*~53--(9yRj;#dk*Y6yw#}i@f?R?QJltnxq6?r2+BjRDXa1l#V zX{a(!Te4_o%Gr{L#S@}z6ww4pY#5rVA{I^VrqI?XoGE8TED}X)XZu4^kVH(6i;`6= zBcY0OJ%zMYNNXaZC+yb#u>%ogrZck;my(F6amqU$QE3t~Pfy03ar8tCxjgYu)<|WH zqR`_J`;neuZ!Atfka>5WdQ^8?=`mpxixw*5a5H8RvTYTY3#q&zbX9Z8v}E$OGA)5w zS7u6(q{11{VYDHB0 zcklXKJr;|KfLOhJ{p#B4wSdr*Dqf*ocKfGb`o`6#S?Q>v9u|S! zm57Xmtt(h%VJw-YGK#~oUsBwIxuJQbP_%z~_Xq60-qiktz$%SYUfB8Gh59xG$TvO1 zVsz=9{;PLpecN4U{mR3Sk(4>2Cq;34za_f^ro(Oyxe7v&I^-|Ca%E=M3Wp+9H9*0<-jdvmq1kG`GtE^WShK6mU}jsNxp)o4Pb zb5_Zi{fJN_x-hII1+02J+fhbo*Q=@-d_VB`?k zuu@x#c%-8N#37$5r?V_lk(i*Kxjp25H?1XwHE$G3Ustkb6gy z61rgcG_3;n1sUpi*CN2L`AQibjQ6}p<)$);p5VNIc+Z&7xBNU%PE}bnF@BET!g6f{ zg-MwtD8!1fCzKiI6y>!qk8m@MJm@TXO%>%rO}snGZVIUGF6532<+pl09`AH&!xf&o zr@wi(D^g0{`=SbjYJ(QM|d;VPHx-}#*uCrtatcMR60)HV)V!<@PE+p>&B z?|DXjwEuzCr&xYv4Kt!Yq~)&!{FRZloo3qYf9FdWS>aw#-SRgM$&Q<&=s{-ty|lCu z1?o`uc;sv_VJ=MZ$ZsC9M&2B}eYl<4PGi{WldF~Ml+~N}7OXyN7&_yu;)XTy9BWL6 zn*8E9M@{sYDq&x*s}Y&fl93J>*YrKvQ2~yntX0WnU^3LCE?cND1#COisFMJ=Nqqqh z%LHT&X2vL%0J@N52&*2C0|E7DR7~P0QcsGBNg!52JbMa1VR1@mWS@vRxT3E?_D=$J zVaq$Rp=zgv3Yb2HC$&_8rzZtr0G_Z!D1{2*iD^tg;-jd8rJNKnB&RVKNcR5VNmMvB zKHg)0Z~qAJ;dJ*EkK*yB>_-n=sYA0Xlj&5+5LhCqGO75iY2-3OPq2Mq7?BW@baq4U ztVtRkhVqxQuvaRurEDyf1z%IZ}!GKnZ zX#=~!ibn_|5?e3&jV`5X|M=kNmCN?|p;6_E{mG%jL#%6O`DqPr-@%Ey?LQbgsXS%> z+mKn$a!xNx+IOvS2+85S)J7NtZM^aK4gvgw)a^_{L0FGQYDYGv_7zM ztYx{$V9PqTC9GgmPQVKC0H{%0p`x##~9P|QJ=B`$5uqE@l#JQ z3UqaBe~4jKMCs%u8*p>5jgHMtTNy({aG|i89@=TvQhdCWd>A#>y?jdi`1tAHxlVZ;(++XHBeb%CsbB;IlIG6a5(1F)I`xBW@Q!gr3qoe6LXlTDZtgq zDf^o5gLN$9ONz&{Z@TJh9&2U3lDcqbYg+Lt7rgWX!Mf1J3FSgJew7QJH?Q-GGQ4UQ z!3-}HCb5S9e#OI?oW~C~^sW24l|fmtweG8BBwO7e8|{%@wbJr;=FNj`1I)-wY?%s! z;hgdA?y35&1b}!tr9dX$Nl1qyC?xyX58jSSVbLrA-;?58ej#VpOJ$KDP;B4ER5%=l z6BZFxr3@M~r9*4EQtt*&BS&u-5h;cw%TV01&LH-4h1P*xM{57$05ijI8m|r;L@hH<(Z*!#8FO=#2 zd%Dj0wtEM&{h#j5`?fz+@GBo>A<42dZ1>IaTWu^mwxlf2nclI{)>-dEjlWV>2E2-* z5Obu2S6LZxQbavT2v&%DdK;(7iT7Ef?y8DrMi7*|{& z0=<2}^4G>z`o5d@KD_yhUs(QQ;Ma|x!+N)@K>swt3JtT0@Ick8yn?k_M}CdeNU;R( zk#!st_c$`>;XLbJ8ive$5MJLgbUyJJ>lk7R6tDQEH6bGuD}k1E*t>Fg^W7;=PzTPP zbG&_WS@)bIEk+018DxM(blfftbcy2yAFJ*6@ZH~@0 zhtJOKY~2SUM)Ehu2fVX2l)bbg$(n!qlF2aT&tCeww;DDe2vmA6Y(bWW2`tkjY+>6Q zC??Z)*hER=lO5I;`q^fD$Ab>AlN|y^s3Hi$1hN{5k0UtJ_O|u4@L%lTuez?c{e=%6 zt7{BM9aujLfG1i8TLt9HT8l8=M1Y~tL9frF^!q&}2I)0kU$a&d$g;S{TLTEj&Mae2InkM{oPtz$`2mD->+oFc9-d|uJ`UV zA8BQ!j;{CYG(VITEpzW6n}cPO+hy;@k$JZMyyma-`_0Dpeo3`AYBFSUv+){r`bvA% zp^hG3-hB5dxANw@k9&d|0N)98glH#m9z&%{#0Rv8x#?(@;n?%!`jC|D7*HFsR``no~$!wI7)zRFiZ1GSw!%FARqQA_U6f>_H^Lr zTvTdLJ2QZZW@Z3l0CMJ>y<`O77#!`y7E{=@lLu@)aq4pq)Tv_3wd1N-V zq%5qg5#%>if6rg_-MCr%ta3B!eamFM<43FU?|^uRE-%8B7mKq+D-ZLH&=O9XD2%mO zDN)?mn#XjQts}P!*`=*p)lo%XJ>>Ir8_gVI<3?ke&FWm$w-sCr^Z46G+W=Am-V64J zE`H#|ADP|qfy2V<>#Fp z6Hy9ySDZJN(r6+oQsr_goy{AC3cOu}<7eOs&l#baA~q9&g-ARm&ZXuNVax!NA*C>{ zV3-JTmW@1oB19{8yR5Tz!cCP&l*)iulD@hjMgyk_WT!BFsth%T4$A1hj-cZ#U^;7< zXR>8@PzjoR(Ky5YEp)ZL5Wyg)nFcA5jvL=6h`Nduwr8k&bye_Yu4T^3*+J*^j>=ek zI^!%mBzq|d@NOr@FJsy4P9j#~8u?%pvGqy;R|Z&B2CXU_j}lS3*}&SPfT1EUDhhze z7_+HLu1uSqMXU$+U{QcsI!BU>a}rS)Jo~vPj?^Q-zh}C9RFNR|-e(ZEp;!fTQ=~B_ z4hMcr3Z8xEnSf}_FQexOD2$tgMQ%T~5c7Si0}yu8I=0ze$o$?yblCRYZIKGDLnI_1 zQrryyMYjv-jKIy`6un@WAKRY4^Ae-`lg+2Vjx&|Ga*7HW%qi+=8~%pmh;-5BKWIl2BL?wcQF zt}?b;M_E7k&RXvsL^682>AC57Re6Y;y(%MjEz`Ta`R+9ytM1up9%`*|vGn&PgK1oF zrt(#HN*bp0e-6l4N%I9+lF{$RJ@3;ix}Zu7f=ipq57zb*fAzEvys3QM9r2-7W&6;3 zr?#oQc-i}HS?T>J^!U5(4%B#a7Uh+ZJ8WTZ09;us|rw=g7_OZzv8%wD?f_+5Q zU~6DXaEHcs5r$*@q6pNUGYh3k5qIXqdtf6d2ADC+lO=<$59+WBa%NG4Z*OlO0UPdY zAE9_O?@J`oxsnL%+Fs8QL^+*~BbfQ^9qWiXa>uy#b7rQ)eU?4zbgR*}%{neAof5Tk z6DYL3JLaSl(k_7k$k>*SsCVayX%xkmH-vnxq19mwcP9t;*`(_o@P5R&I`)m6e>n$Y z3GK5}sY@dGFcYw{bep;e2Y@aIN-hnetEk;koU@@jpmXMU`{Cf56PSP{x{rYk>KI?w z?bH*4b?hoRL$Eh-kgq*c!XHYwA^jN4e|qD})Ax&$llZtHu^a1;!LN`7lc&K=5X~Zv z0Z$@l%u=WhjDB_XesN*rdJW7CTZ`fdlOPmFz%}Yzes%4!+I8FoAnZ!~4Bu)l`MZ1ClH-(N1*GP0bM#sSSMJnhUb)-Vpc_I`jl-Ejdk7USi6(@=1 z9&k-38QgdzY@h$+$iX=JM`ZBI8b18Fz5!|wi$|#d-!b6UqN9K=Dy+-vPm7JqtIRL( z(NPrf`(QYPi@$hSg~J3j4v=mHe(% delta 6525 zcmaJ_Z){uFb>|}`H=-)VW{_q>Nzgw;gXU?M5&Nj(-0l54jYudlv*b7^^Tfh>OE=IynolO$zLpZIRLN;}mlT{j^Vs5=E9{hT;BF8lCc1 zog~R($-a=K6=%wV1gv6o>8>V?1axQf{fh2Z{l_kAI+@KDQZ!#AMWShh%_`YB)=^28 z^;FhYL|b8PnPdxT%E)ShHyKrple}3@WeR5AX5AP`5%-Qi@f;+ZC7UZ#B%oS$pX7?NkNW~AEOAO}#``Yst1b02o>up$>5VS+ePZYdMsZi{(=O>fbo{cJvd#_C zLj%2xY@1xvl^IiT<$J@2^Y7&zZux#SEc zaEykyo-}kloqlUedUuF-FJ;Cyzb;ijBNf~$`<|}wvZ>buUXw+YgwyNt<`|u!XCHl?cQ*L{>-@hu z3o+RI`*ix@R^9gvI@HL~*#$nf^X(S@&hou&%7XZAH|-dm71VEaQD5hlh0uF6DbZK`2ZIO|SrXEQ{TLUEz8P^a+>jngEZrPFN{9#ZQrJF4-j z-lFREL8{lrt7=tl(TKkq+4^mi>ZhwJj7vl5T9>-}nSq9U6N*|#0Hv&ADO)HLMP(sj z=Vytc7<#)U$Gn!D&^m#q$WfU%8CuC%Y@*y@ml1j}USt zmN1||q*7$``K(pWI3yO=2x1yqkytEBn05+@MfG;eh?AUMI9JY)m=-4vEtSzw$z^~- zA*B*S*EuKQKQWs%=$u7@=&=5?yYOX$dy=1ly4oSBYDE<4})=wOFIBMdNL0TC}}{ zhV9s;5-kDj6k=sdcB)KEmpE)`u&6hNbJ{zmVpmRO)&X`E&H>&GQYdFq8M8!Gn6hgG z^2JCULqJ#ff?aa3N|qLgl8A~Gfb(z=m6(-s2D&IpOd)6R(c@%_e^qj33Vm52UwjTO z0XqLE{G&$6G>A%qf8;1ROA?7V`{!a3Q3GtF34@I%bT+KUWyn|cgnR3W2bW?onS{yW z%KGi4#kDZe;|X+;oA9qkS$l19dGY%C(#lJWq8lW9b&agP$T~`#g#T!bacXfiQ%HbU zZwp2Zx#)P`SZ@%fjl0Rd<1EJ{`;PUiaG8l|Xz|>n`}w|8QqX;;&vgHzuUy|iqz7hZ zIr!Z8aQND%GJ)-$7lx!O0tmOC$O~K=Y~`~YMDpgF3$N3`?SVWGKu+T<{I84H-K2wJ zF6ZG9jv)W}`R)BAR~!GmzsmS8Zr;zG{@LdLAco}xv1zV+sc6H%8oc{t9VdUzE;Em3 zd5^^PJ>8f_&haROw~26shj;VqT32QSKrlgkf@%qJ6?Zw6EVO0n-4&tV{J!JPtW%vIMeN|d=?~jg6-Jl_n zDZaszcr_%z|2!v(v`<6ZpW=i4?mv%COMl`X3}r|2oHD>Y;1?PHcWOU5nD2A%hEDdr zwdMOUb>9gcf95k>$fxNs&Q(3rqNkfaGha-@Z(ZDvsFcN|LgGTCDc#5TsqFI%lwK)Jm}Ma4;p|KC=q8^q~bvE z4;a1x{9Iyb#d>W>`l*?fxPhBzvywRCrk)iA$#P_;@i~+GGn!2b)@46u=6^rv zbesBY)-S~T01Y9gadIY$s)4h<$69|`PvPU29=(^{4lE5J@V7qtB7z=yMF4xmo~xKS zf)L!(M<9A=&(9AKxo21;0C9*&ju|9QmXF#kz;v5^kcnq8p5S(F{>!)(n#P?3@Z1534D3w4p#LWp@Sq!v#)OQ#+Ys*9EaiL7E!kgGfj zP>8qO=gFIkS|WxVCN36aX^kwtd~^K{+!uD}%8%+Na-xcu>f}UK*4sIerSUyE5m&Te z^MA=_rRKk$`prP|Kcj!w*M}lQWEi(NeYCDH=djH@NfUTshR(x#IFzP|Mod{YWW>z3 zrGQVG<6h1Ggfk2e`R2%WZ)S6OVR>MuVYTK&+FTCqG{)yhE5i?)ds8#P=lx{!@4JZK zEM;D*^XmR7Z?ws#{;-RsLBPXU=6IFce5*Dhvgq}FtyBA?Au(_3qgN3{@c7I53%RVr zir-Eejj%nj%0^@t)FC{}04VtPdBDu&qHUkYEtDYBIJ=n^aiX9!%%vetV;`Vlszh*< z_y>fhN}#zL&mPrS)}8>7Q6>o-W&$Ik1D_F{$;qH+b{JJw-GQrPlI;E{u0Gk$_em=r zoG21SSRJ=ejsiFu_oy|t52sM_``nCm(tU6>dIO83a!DR61PQ;rafCzHDhdFe(4r0O zjCJZhI8)M`Wo0%}a2K-*xF^YMp;##cKS@$xHh{PJ57vWEH+Po%r6->~9PsV48%f+W z?ac_gX$H|te;T|NVUy5+m;eqrUaXO??%{BS?C`RB%mNU{qw^yp!WhN?$e%LnL@M~wdqJiPhKvk$Y=P+*7VBxUaANd)DXZf3FoHJ#Bt)}ZHd7h)i~{qac9=zCJ#R;5OLX2rt)as>m(3!qYQbbk zhq&+{#!;P>?K}VpxwRv*&SYwkDIQej5!pIPBfv6t_FSe6n29r`O7=OP;BbZL9z@YC zfScc>kj>zpy#5z`1$*?&84EX<65oe`#BJGWvyv+_yJb+|;R#Al9Kg@{yBMT?i1WCUEN zsk;Xrgr+s*GzP3?3~Pq`Nwqum0hS_oID7f(%EB7EM`%$uB8LtGBUE%hHmJIpwG+*? zHK(ta@1prPuf65(JrR(60rwB<$Di^|02`caGFh?#9hCy}EWmvyAdzU?;aA6cuzKA6 zrFC#@GPwIj=S92>+c{=R`Ce$w&qGTrz{>WhB`zJ&;qnM5oo;g{kDwIT#3Ug=Hb%f zP3?ZdnkzYF@%Zp@IS|u$rZu;HNIY(J57!oW&*6X}X15o7rd2Qfjw$8GOgY|~`&Q|l z->rz&5}B)3;%LOB3`@Su+gy>%pOyHRlk1)>_`Y`pq{d_159G$8ZgyF3z;m1MuyZ3YMlk-Oc zlVA(JVY7EOEVuB++{gvIUXTe|01U%XEiw^wZ+tE54t-_+$VAukJt<^y0cu9RGTQt9 DGIR@y diff --git a/lispusers/COMPAREDIRECTORIES.TEDIT b/lispusers/COMPAREDIRECTORIES.TEDIT index eb01c6c3..8915d21d 100644 --- a/lispusers/COMPAREDIRECTORIES.TEDIT +++ b/lispusers/COMPAREDIRECTORIES.TEDIT @@ -6,7 +6,8 @@ XEROX COMPAREDIRECTORIES2 By: Larry Masinter and Ron Kaplan This document edited on December 2, 1987 December 28, 1998 (Ron Kaplan) April 7, 2018 (Ron Kaplan) Rewritten December, 2021 (Ron Kaplan) COMPAREDIRECTORIES compares the contents of two directories, identifying files according to their creation dates and lengths. It is called using the function (COMPAREDIRECTORIES DIR1 DIR2 SELECT INCLUDEDFILES EXCLUDEDFILES USEDIRECTORYDATES OUTPUTFILE ALLVERSIONS) [Function] Compares the creation dates of files with matching names in the lists that CDFILES returns for DIR1 and DIR2. Collects or prints CDENTRIES for those files that meet the SELECT criteria. May also collect or print entries for relevant files that exist in DIR1 or DIR2 but not both. SELECT specifies which the match/mismatch criteria for filtering the output. If SELECT is or contains AFTER or >: select entries where file1 has a later date than file2 BEFORE or <: select entries where file1 has an earlier date than file2 SAMEDATE or =: select entries where file1 and file2 have the same date -*: exclude entries where file1 does not exist *-: exclude entries where file2 does not exist ~=: exclude entries where file1 and file2 are byte-equivalent SELECT = NIL is equivalent to (< > -* *-). Excludes files with matching dates, a useful default for identifying files that may require further attention. SELECT = T is equivalent to (= < > -* *-). Includes all files for processing by other functions or later filtering by CDSUBSET (below). SELECT may also contain the token AUTHOR to indicate that authors should be provided in the printed output (see CDPRINT below). Unless USEDIRECTORYDATES, the FILECREATED date is used for the date comparison of Lisp source and compiled files, otherwise the file-system CREATIONDATE is used. If OUTPUTFILE=NIL, then the value is a CDVALUE structure with fields (CDPARAMETERS . CDENTRIES). CDPARAMETERS records the parameters in the call to COMPAREDIRECTORIES and CDENTRIES is the list of per-file comparison results. CDPARAMETERS has fields CDDIR1 CDDIR2 CDCOMPAREDATE CDSELECT. -CDENTRIES contains one entry for each of the file-comparisons that meets the SELECT criteria. Each entry is a CDENTRY record with fields MATCHNAME INFO1 DATERULE INFO2 EQUIV where MATCHNAME is the name.extension shared by the two files, and each file info is either NIL (for nonexistent files) or a CDINFO record with fields (FULLNAME DATE LENGTH AUTHOR TYPE EOL) TYPE is SOURCE for Lisp source (filecreated) files, COMPILED for Lisp compiled files, otherwise the PRINTFILETYPE (TEXT, TEDIT...) or NIL. EOL is CR, LF, CRLF, or NIL. When both files exist, the date relation is one of <, =, or >. Otherwise, the date relation is * if only one file exists. EQUIV is EQUIVALENT for files with different dates but exactly the same bytes, otherwise NIL. If OUTPUTFILE is not NIL, then it is a filename or open stream on which selected entries will be printed (T for the terminal) by CDPRINT. COMPAREDIRECTORIES always sets the variable LASTCDVALUE to the CDVALUE data structure. This is used by the functions below if their CDENTRIES is NIL. (CDPRINT CDVALUE FILE COLHEADINGS PRINTAUTHOR ) [Function] Prints CDVALUE on FILE, with one line for each entry. The line for each entry is of the form FILE1 (AUTHOR) SIZE DATE DATEREL DATE FILE2 (AUTHOR) SIZE For example ACE.;1 (Joe) 235 2-May-1985 18:03:54 < 30-Sep-1985 11:14:48 ACE.;3 (Sam) 396 The line for byte-equivalent files is prefixed with ==. If the files are equivalent except for a difference in end-of-line conventions, the equivalence prefix will indicate the convention for each file (C for CR, L, for LF, 2 for CRLF). Thus C2 indicates that the files are equivalent except that file1 marks line ends with CR and file2 with CRLF. +CDENTRIES contains one entry for each of the file-comparisons that meets the SELECT criteria. Each entry is a CDENTRY record with fields MATCHNAME INFO1 DATERULE INFO2 EQUIV where MATCHNAME is the name.extension shared by the two files, and each file info is either NIL (for nonexistent files) or a CDINFO record with fields (FULLNAME DATE LENGTH AUTHOR TYPE EOL) TYPE is SOURCE for Lisp source (filecreated) files, COMPILED for Lisp compiled files, otherwise the PRINTFILETYPE (TEXT, TEDIT...) or NIL. EOL is CR, LF, CRLF, or NIL. When both files exist, the date relation is one of <, =, or >. Otherwise, the date relation is * if only one file exists. +EQUIV is T for files that contain the same bytes. In that case, the date of the earlier file is assumed to be more accurate, it replaces the CREATIONDATE of the earlier file, and the date relation is changed to =. If OUTPUTFILE is not NIL, then it is a filename or open stream on which selected entries will be printed (T for the terminal) by CDPRINT. COMPAREDIRECTORIES always sets the variable LASTCDVALUE to the CDVALUE data structure. This is used by the functions below if their CDENTRIES is NIL. (CDPRINT CDVALUE FILE COLHEADINGS PRINTAUTHOR ) [Function] Prints CDVALUE on FILE, with one line for each entry. The line for each entry is of the form FILE1 (AUTHOR) SIZE DATE DATEREL DATE FILE2 (AUTHOR) SIZE For example ACE.;1 (Joe) 235 2-May-1985 18:03:54 < 30-Sep-1985 11:14:48 ACE.;3 (Sam) 396 The line for byte-equivalent files is prefixed with ==. If the files are equivalent except for a difference in end-of-line conventions, the equivalence prefix will indicate the convention for each file (C for CR, L, for LF, 2 for CRLF). Thus C2 indicates that the files are equivalent except that file1 marks line ends with CR and file2 with CRLF. COLHEADINGS can be a pair (col1 col2) of strings to be printed as column headings. Note that because COMPAREDIRECTORIES sets LASTCDVALUE, evaluating (CDPRINT) after COMPAREDIRECTORIES prints the results of the last comparision. For conciseness, authors are included only if PRINTAUTHOR or if AUTHOR is included in the CDSELECT parameter of CDVALUE. Also, redundant file-name hosts/directories are not printed. (CDTEDIT CDVALUE TITLE COLHEADINGS PRINTAUTHOR) [Function] @@ -14,7 +15,9 @@ Produces the CDPRINT output in a read-only TEDIT window, with TITLE if given. (CDBROWSER CDVALUE TITLE COLHEADINGS BROWSERPROPS SEPARATEDIRECTIONS MENUITEMS PRINTAUTHOR) [Function] Produce the CDPRINT output in a TABLEBROWSER window with menu commands for comparing the contents of individual files, viewing files in read-only TEDIT windows, copying files from one directory to another, etc. Lisp source files are compared with COMPARESOURCES, text files with COMPARETEXT. If SEPARATEDIRECTIONS, the entry lines are grouped according to whether the date relation is < or >. -(CDFILES DIR INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH) [Function] Returns a list of full filenames for files in directory DIR (NIL=T=the connected directory) that match the other file-name filtering criteria. Files are excluded if: Their name does not match a pattern in INCLUDEDFILES (NIL = *.*). Dotted files are excluded unless FILEPATTERNS includes .* and files in subdirectories are excluded if the number of subdirectories exceeds DEPTH (below). They do not match patterns on the list EXCLUDEDFILES. *.* excludes all extensions, *.COM or just COM excludes extentsions on *COMPILED-EXTENSIONS*. EXCLUDEDFILES contains .* to suppress dotted files unless .* also appears in INCLUDEDFILES. They are not the highest version unless ALLVERSIONS=T. DEPTH controls the depth of subdirectory exploration. T means all levels, NIL means no subdirectories. Otherwise the maximum number of > or / characters below the starting DIR in the fullname of files. (CDFILES) produces all the newest, undotted files in the immediate connected directory. (CDMAP CDVALUE FN) [Function] (CDSUBSET CDVALUE FN) [Function] CDMAP applies FN to each CDENTRY in CDVALUE. CDSUBSET applies FN and also returns the subset of the entries for which FN is non-NIL and preserves in the value the parameters of CDVALUE. For convenience, at each invocation the variables MATCHNAME INFO1 DATEREL INFO2 and EQUIV are bound to the corresponding fields and can be used freely by FN. USEFUL UTILITIES (FIX-DIRECTORY-DATES FILES) [Function] For every file included in or specified by FILES, if it is a Lisp source or compiled whose directory creation date is more than 30 seconds later than its internal filecreated date (presumably because of copying), then its directory date is reset to match the internal date. FILES can be a list of file names or a pattern interpretable by FILDIR. Returns a list of files whose dates have been changed. (FIX-EQUIV-DATES CDVALUE) [Function] If there is an entry in CDVALUE whose files are EQUIVALENT but with different directory creation dates, the directory date of the file with the later date (presumably a copy) is reset to match the date of the earlier file. In the end all equivalent files will have the same (earliest) date. Returns a list of files whose dates have been changed. (COPY-MISSING-FILES CDVALUE TARGET MATCHNAMES) [Function] Target is 1 or 2, indicating the direction of potential copies. If an entry with a source file but no target file has a matchname in MATCHNAMES, the source file is copied to the target directory. All target-absent files are copied if MATCNAMES is NIL. Source properties (including version number) are preserved in the target. (COPY-COMPARED-FILES CDVALUE TARGET MATCHNAMES) [Function] TARGET is 1 or 2, indicating the direction of potential copies. If an entry with both source and target files has a matchname in MATCHNAMES, the source file is copied to a new version of the target file. All files are copied if MATCHNAMES is NIL. (COMPILED-ON-SAME-SOURCE CDVALUE) [Function] Returns the subset of entries with Lisp compiled files (dfasl or lcom) that are compiled on the same source, according to SOURCE-FOR-COMPILED-P below. Presumably one should be removed to avoid confusion. (FIND-SOURCE-FILES CFILES SDIRS DFASLMARGIN) [Function] Returns (CFILE . SFILES) pairs where CFILE is a Lisp compiled file in CFILES and SFILES is list of files in SDIRS that CFILE was compiled on according to SOURCE-FOR-COMPILED-P. This suggests that at least one of SFILES should be copied to CFILE's location (or vice versa). (FIND-COMPILED-FILES SFILES CDIRS DFASLMARGIN) [Function] Returns (CFILE . SFILES) pairs where SFILE is a Lisp source file in SFILES and CFILES are files in CDIRS that are compiled on SFILE according to SOURCE-FOR-COMPILED-P. This suggests that at least one of CFILES should be copied to SFILE's location. (FIND-UNCOMPILED-FILES FILES DFASLMARGIN COMPILEXTS) [Function] Returns a list of elements each of which corresponds to a source file in FILES for which no appropriate compiled file can be found. An appropriate compiled file is a file in the same location with extension in COMPILEEXTS (defaulting to *COMPILED-EXTENSIONS*) that satisfies SOURCE-FOR-COMPILED-P. Each element is a list of the form (sourcefile . cfiles) cfiles contains compiled files that were compiled on a different version of sourcefile, NIL if no such files exist. Each cfile item is a pair (cfile timediff) where timediff is the time difference (in minutes) between the creation date of the compiled-file's source and the creation date of sourcefile (positive if the cfile was compiled later, as should be the case). FILES can be an explicit list of files, or a file specification interpretable by FILDIR; in that case only the newest source-file versions are processed. (FIND-UNSOURCED-FILES CFILES DFASLMARGIN COMPILEXTS) [Function] Returns the subset of the compiled files specified by CFILES for which a corresponding source file according to SOURCE-FOR-COMPILED-P cannot be found in the same directory. CFILES can be a list of files or a pattern that FILDIR can interpret. COMPILEEXTS can be one or more explicit compile-file extensions, defaulting to *COMPILED-EXTENSIONS*. (SOURCE-FOR-COMPILED-P SOURCE COMPILED DFASLMARGIN) [Function] Returns T if it can confirm that Lisp COMPILED file was compiled on Lisp SOURCE file. SOURCE and COMPILED can be provided as CREATED-AS values, to avoid repetitive computation. This compares the information in the filecreated expressions, original file names and original dates, and not the current directory names and dates. It appears that the times in DFASL files may differ from the filecreated source dates by a few minutes. The DFASLMARGIN can be provided to loosen up the date matching criterion. DFASLMARGIN is a pair (max min) and a DFASL COMPILED is deemed to be compiled on SOURCE if the compiled's source date is no more than max and no less than min minutes after the source date. A negative min allows for the possibility that the compiled-source date is earlier than the candidate source date. DFASLMARGIN defaults to (20 0). A single positive number x is coerced to (x 0). A single negative number is coerced to (-x x) (compiled file is no more than x minutes later or earlier). T is infinity in either direction. Examples: (T 0): COMPILED compiled on source later than SOURCE (0 T): COMPILED compiled on source earlier than SOURCE (odd) +(CDFILES DIR INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH) [Function] Returns a list of full filenames for files in directory DIR (NIL=T=the connected directory) that match the other file-name filtering criteria. Files are excluded if: Their name does not match a pattern in INCLUDEDFILES (NIL = *.*). Dotted files are excluded unless FILEPATTERNS includes .* and files in subdirectories are excluded if the number of subdirectories exceeds DEPTH (below). They do not match patterns on the list EXCLUDEDFILES. *.* excludes all extensions, *.COM or just COM excludes extentsions on *COMPILED-EXTENSIONS*. EXCLUDEDFILES contains .* to suppress dotted files unless .* also appears in INCLUDEDFILES. They are not the highest version unless ALLVERSIONS=T. DEPTH controls the depth of subdirectory exploration. T means all levels, NIL means no subdirectories. Otherwise the maximum number of > or / characters below the starting DIR in the fullname of files. (CDFILES) produces all the newest, undotted files in the immediate connected directory. (CDMERGE CDVALUES) [Function] +Merges all subsets of CDVALUES that have the same CDSELECT into a single CDVALUE with the union of their CDENTRIES. The CDCOMPAREDATE of the merger will be the latest of the dates, and the directories and match names will be adjusted to reflect the original subdirectory sources. + (CDMAP CDVALUE FN) [Function] (CDSUBSET CDVALUE FN) [Function] CDMAP applies FN to each CDENTRY in CDVALUE. CDSUBSET applies FN and also returns the subset of the entries for which FN is non-NIL and preserves in the value the parameters of CDVALUE. For convenience, at each invocation the variables MATCHNAME INFO1 DATEREL INFO2 and EQUIV are bound to the corresponding fields and can be used freely by FN. USEFUL UTILITIES (FIX-DIRECTORY-DATES FILES) [Function] For every file included in or specified by FILES, if it is a Lisp source or compiled whose directory creation date is more than 30 seconds later than its internal filecreated date (presumably because of copying), then its directory date is reset to match the internal date. FILES can be a list of file names or a pattern interpretable by FILDIR. Returns a list of files whose dates have been changed. (FIX-EQUIV-DATES CDVALUE) [Function] If there is an entry in CDVALUE whose files are EQUIVALENT but with different directory creation dates, the directory date of the file with the later date (presumably a copy) is reset to match the date of the earlier file. In the end all equivalent files will have the same (earliest) date. Returns a list of files whose dates have been changed. (COPY-MISSING-FILES CDVALUE TARGET MATCHNAMES) [Function] Target is 1 or 2, indicating the direction of potential copies. If an entry with a source file but no target file has a matchname in MATCHNAMES, the source file is copied to the target directory. All target-absent files are copied if MATCNAMES is NIL. Source properties (including version number) are preserved in the target. (COPY-COMPARED-FILES CDVALUE TARGET MATCHNAMES) [Function] TARGET is 1 or 2, indicating the direction of potential copies. If an entry with both source and target files has a matchname in MATCHNAMES, the source file is copied to a new version of the target file. All files are copied if MATCHNAMES is NIL. (COMPILED-ON-SAME-SOURCE CDVALUE) [Function] Returns the subset of entries with Lisp compiled files (dfasl or lcom) that are compiled on the same source, according to SOURCE-FOR-COMPILED-P below. Presumably one should be removed to avoid confusion. (FIND-SOURCE-FILES CFILES SDIRS DFASLMARGIN) [Function] Returns (CFILE . SFILES) pairs where CFILE is a Lisp compiled file in CFILES and SFILES is list of files in SDIRS that CFILE was compiled on according to SOURCE-FOR-COMPILED-P. This suggests that at least one of SFILES should be copied to CFILE's location (or vice versa). (FIND-COMPILED-FILES SFILES CDIRS DFASLMARGIN) [Function] Returns (CFILE . SFILES) pairs where SFILE is a Lisp source file in SFILES and CFILES are files in CDIRS that are compiled on SFILE according to SOURCE-FOR-COMPILED-P. This suggests that at least one of CFILES should be copied to SFILE's location. (FIND-UNCOMPILED-FILES FILES DFASLMARGIN COMPILEXTS) [Function] Returns a list of elements each of which corresponds to a source file in FILES for which no appropriate compiled file can be found. An appropriate compiled file is a file in the same location with extension in COMPILEEXTS (defaulting to *COMPILED-EXTENSIONS*) that satisfies SOURCE-FOR-COMPILED-P. Each element is a list of the form (sourcefile . cfiles) cfiles contains compiled files that were compiled on a different version of sourcefile, NIL if no such files exist. Each cfile item is a pair (cfile timediff) where timediff is the time difference (in minutes) between the creation date of the compiled-file's source and the creation date of sourcefile (positive if the cfile was compiled later, as should be the case). FILES can be an explicit list of files, or a file specification interpretable by FILDIR; in that case only the newest source-file versions are processed. (FIND-UNSOURCED-FILES CFILES DFASLMARGIN COMPILEXTS) [Function] Returns the subset of the compiled files specified by CFILES for which a corresponding source file according to SOURCE-FOR-COMPILED-P cannot be found in the same directory. CFILES can be a list of files or a pattern that FILDIR can interpret. COMPILEEXTS can be one or more explicit compile-file extensions, defaulting to *COMPILED-EXTENSIONS*. (SOURCE-FOR-COMPILED-P SOURCE COMPILED DFASLMARGIN) [Function] Returns T if it can confirm that Lisp COMPILED file was compiled on Lisp SOURCE file. SOURCE and COMPILED can be provided as CREATED-AS values, to avoid repetitive computation. This compares the information in the filecreated expressions, original file names and original dates, and not the current directory names and dates. It appears that the times in DFASL files may differ from the filecreated source dates by a few minutes. The DFASLMARGIN can be provided to loosen up the date matching criterion. DFASLMARGIN is a pair (max min) and a DFASL COMPILED is deemed to be compiled on SOURCE if the compiled's source date is no more than max and no less than min minutes after the source date. A negative min allows for the possibility that the compiled-source date is earlier than the candidate source date. DFASLMARGIN defaults to (20 0). A single positive number x is coerced to (x 0). A single negative number is coerced to (-x x) (compiled file is no more than x minutes later or earlier). T is infinity in either direction. Examples: (T 0): COMPILED compiled on source later than SOURCE (0 T): COMPILED compiled on source earlier than SOURCE (odd) 12: COMPILED compiled on source later than SOURCE by no more than 12 minutes -12: COMPILED compiled on source 12 minutes before or after SOURCE (FIND-MULTICOMPILED-FILES FILES SHOWINFO) [Function] Returns a list of files in FILES that have more than one type of compiled file (e.g. LCOM and DFASL). FILES is interpretable by FILDIR. If SHOWINFO, then the value contains a list for each file of the form !(rootname loaded-version . CREATED-AS information for each compile-type) Otherwise just the rootname of the source is returns. (CREATED-AS FILE) [Function] If FILE is a Lisp source or compiled file, returns a record of its original filename and filecreated dates, and for compiled files, also the original compiled-on name and date. The return for a source file is a pair (sfullname sfilecreateddate) The return for a compiled file is a quadruple (cfullname cfilecreated sfullname sfilecreateddate) where sfullname and sourcefilecreated are extracted from the file's compiled-on information. The return is (fullname NIL) for a non-Lisp file. (EOLTYPE FILE SHOWCONTEXT) [Function] Returns the EOLTYPE of FILE (CR, LF, CRLF) if the type is unmistakable: contains at least one instance of one type and no instances of any others. Returns NIL if there is evidence of inconsistent types. If SHOWCONTEXT is an integer, it is the number of bytes for EOLTYPE to display before and after an instance of an inconsistent type. At each instance, the user is asked whether to continue scanning for other instances. SHOWCONTEXT = T is interpreted as 100. (BINCOMP FILE1 FILE2 EOLDIFFOK) [Function] Returns T if FILE1 and FILE2 are byte-identical. If EOLDIFFOK and FILE1 and FILE2 differ only in their eol conventions, the value is a list of the form (EOL1 EOL2), e.g. (CR CRLF). Otherwise the value is NIL. (LIST ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC) STARTINGPAGE# 1) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))))) 444 4.4@4..8.8J PAGEHEADING RUNNINGHEAD.MODERNTERMINALMODERN TERMINAL MODERN MODERN @@ -26,13 +29,13 @@ Produce the CDPRINT output in a TABLEBROWSER window with menu commands for compa  HRULE.GETFNMODERN    HRULE.GETFNMODERN   HRULE.GETFNMODERN #!'o K  Of@A?44C  m -H  c   ' .   $ D( o*&m +H  c   ' .   $ D( o*&m{ = ~ ?  <G@ L]  .   .. @@ * m    H= 8k' / ^ '    -! (  O"   F4A'+c& +! (  O"   F4A'+c& !< \ T=| Z  .z=: %< &AI %A64)* D@& K <    ! &/65; -$7".9'  . -  G "  3Yz \ No newline at end of file +$7".9'  . -  G "  5cz \ No newline at end of file diff --git a/lispusers/COMPARESOURCES b/lispusers/COMPARESOURCES index 7dfdcaf6..dc3e06a8 100644 --- a/lispusers/COMPARESOURCES +++ b/lispusers/COMPARESOURCES @@ -1,13 +1,10 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 3-Jan-2022 08:40:38"  -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>COMPARESOURCES.;106 42666 +(FILECREATED "25-Jan-2022 16:05:14" {MM}COMPARESOURCES.;115 41781 - :CHANGES-TO (FNS CSOBJ.BUTTONEVENTINFN CSOBJ.COPYBUTTONEVENTINFN) - (VARS COMPARESOURCESCOMS) + :CHANGES-TO (FNS CSOBJ.BUTTONEVENTINFN) - :PREVIOUS-DATE "27-Dec-2021 11:56:48" -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>COMPARESOURCES.;105) + :PREVIOUS-DATE "24-Jan-2022 23:12:17" {MM}COMPARESOURCES.;113) (* ; " @@ -143,15 +140,17 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation. 'SAME]) (\CS.COMPARE.MASTERS - [LAMBDA (BODYX BODYY DW?) (* ; "Edited 19-Dec-2021 21:05 by rmk") - (* ; "Edited 9-Dec-2021 23:26 by rmk") - (* ; "Edited 4-Dec-2021 10:00 by rmk") - (* ; "Edited 2-Dec-2021 14:25 by rmk:") - (* ; "Edited 27-Nov-2021 12:31 by rmk:") + [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:") (* ; "Edited 15-Apr-88 14:41 by bvm") (DECLARE (USEDFREE DIFFERENCES COMPARESTREAM)) (LET (YTHING XTHING PRED DIFS TMP) + (SETQ BODYX (CL:REMOVE-IF (FUNCTION EDITDATE?) + BODYX)) (* ; + "We don't care about editdate comments") + (SETQ BODYY (CL:REMOVE-IF (FUNCTION EDITDATE?) + BODYY)) (SETQ BODYX (\CS.FIXFNS BODYX)) (SETQ BODYY (\CS.FIXFNS BODYY)) (CL:WHEN (AND (SETQ XTHING (ASSOC 'DEFINE-FILE-INFO BODYX)) @@ -555,50 +554,52 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation. ELSE (ADD LINELENGTH (CHARWIDTH C FONT]) (CSOBJ.BUTTONEVENTINFN - [LAMBDA (OBJ WINDOW) (* ; "Edited 26-Dec-2021 16:28 by rmk") - (* ; "Edited 24-Dec-2021 14:09 by rmk") - (* ; "Edited 20-Dec-2021 11:01 by rmk") - (* ; "Edited 12-Dec-2021 21:30 by rmk") - (* ; "Edited 10-Dec-2021 10:21 by rmk") - (* ; "Edited 7-Dec-2021 17:49 by rmk") - (* ; "Edited 4-Dec-2021 20:05 by rmk") + [LAMBDA (OBJ WINDOW) (* ; "Edited 25-Jan-2022 16:04 by rmk") + (* ; "Edited 23-Jan-2022 18:11 by rmk") (LET [(COMPAREDATA (IMAGEOBJPROP OBJ 'COMPAREDATA] (CL:WHEN (AND COMPAREDATA (MOUSESTATE LEFT) (UNTILMOUSESTATE (NOT LEFT))) - [LET ((NAME (POP COMPAREDATA)) - (TYPE (POP COMPAREDATA)) - (DEF1 (POP COMPAREDATA)) - (DEF2 (POP COMPAREDATA)) - (TITLE1 (POP COMPAREDATA)) - (TITLE2 (CAR COMPAREDATA))) + (LET + ((NAME (POP COMPAREDATA)) + (TYPE (POP COMPAREDATA)) + (DEF1 (POP COMPAREDATA)) + (DEF2 (POP COMPAREDATA)) + (TITLE1 (POP COMPAREDATA)) + (TITLE2 (CAR COMPAREDATA))) - (* ;; "Move the cursor to just slightly below the current object, so that the edit windows are well aligned. We have to figure out the bottom of the current object, in screen coordinates.") + (* ;; "Move the cursor to just slightly below the current object, so that the edit windows are well aligned. We have to figure out the bottom of the current object, in screen coordinates.") - [LET ((OBJREGION (OBJ.FIND.REGION WINDOW OBJ))) - (\CURSORPOSITION (IPLUS 20 LASTMOUSEX) - (IPLUS (IDIFFERENCE (FETCH (REGION BOTTOM) OF (OBJ.FIND.REGION WINDOW OBJ)) - (FETCH (REGION HEIGHT) - OBJREGION)) - (FETCH (REGION TOP) OF (WINDOWREGION WINDOW] - (IF (IMAGEOBJPROP OBJ 'ONLYONE) - THEN [SEDIT:SEDIT - (OR DEF1 DEF2) - `(:REGION ,(RELGETREGION 600 (CL:IF (ILESSP (COUNT (OR DEF1 DEF2)) - 100) - 150 - 400) - 'LEFT - 'TOP NIL NIL T] - ELSE (* ; "Spread the arguments") - (EXAMINEDEFS NAME TYPE DEF1 DEF2 TITLE1 TITLE2 - (RELGETREGION 800 (CL:IF (ILESSP (IMAX (COUNT DEF1) - (COUNT DEF2)) - 100) - 150 - 400) - 'LEFT - 'TOP NIL NIL T])]) + [LET ((OBJREGION (OBJ.FIND.REGION WINDOW OBJ))) + (\CURSORPOSITION (IPLUS 20 LASTMOUSEX) + (IPLUS (IDIFFERENCE (FETCH (REGION BOTTOM) OF OBJREGION) + (FETCH (REGION HEIGHT) OF OBJREGION)) + (FETCH (REGION TOP) OF (WINDOWREGION WINDOW] + (LET + [EWINDOW (RELPOS (RELCREATEPOSITION `(,WINDOW 0.5) + `(,WINDOW 0 -2] + (CL:WHEN [WINDOWP (SETQ EWINDOW (WINDOWPROP WINDOW 'EXAMINEWINDOW] + (CLOSEW EWINDOW)) + (SETQ EWINDOW + (IF (IMAGEOBJPROP OBJ 'ONLYONE) + THEN + [SEDIT:GET-WINDOW + (SEDIT:SEDIT (OR DEF1 DEF2) + `(:REGION ,(RELCREATEREGION 600 (CL:IF (ILESSP (COUNT (OR DEF1 DEF2)) + 100) + 150 + 400) + (CL:IF DEF1 + 'RIGHT + 'LEFT) + 'TOP RELPOS NIL T] + ELSE (* ; "Spread the arguments") + (EXAMINEDEFS NAME TYPE DEF1 DEF2 TITLE1 TITLE2 RELPOS))) + (WINDOWPROP WINDOW 'EXAMINEWINDOW EWINDOW) + (WINDOWADDPROP WINDOW 'CLOSEFN [FUNCTION (LAMBDA (W) + (CLOSEW (WINDOWPROP W 'EXAMINEWINDOW] + T) + EWINDOW)))]) (CSOBJ.COPYBUTTONEVENTINFN [LAMBDA (OBJ WINDOW REGION) (* ; "Edited 3-Jan-2022 08:36 by rmk") @@ -625,14 +626,14 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation. (DEFINEQ (CSBROWSER - [LAMBDA (FILEX FILEY DW? LABEL1 LABEL2 REGION) (* ; "Edited 26-Dec-2021 21:06 by rmk") - (* ; "Edited 24-Dec-2021 22:48 by rmk") - (* ; "Edited 20-Dec-2021 09:55 by rmk") - (* ; "Edited 16-Dec-2021 12:38 by rmk") - (* ; "Edited 10-Dec-2021 12:03 by rmk") + [LAMBDA (FILEX FILEY DW? LABEL1 LABEL2 REGION) + + (* ;; "Edited 24-Jan-2022 23:11 by rmk: EXAMINE is non-NIL, we run the compare twice. Once to get the TEDIT up as a kind of table of contents, and the second time to run through all of the SEDIT windows.") (* ;; "If EXAMINE is non-NIL, we run the compare twice. Once to get the TEDIT up as a kind of table of contents, and the second time to run through all of the SEDIT windows.") + (* ;; "Returns browser window") + (* ;; "Don't use the INFILEP value, because that might screw with capitalization that the caller prefers. If the file can be found that way, then lower functions will find it.") (DECLARE (SPECVARS LABEL1 LABEL2)) @@ -651,24 +652,24 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation. " and " (OR LABEL2 (PACKFILENAME 'HOST NIL 'DIRECTORY NIL 'BODY FILEY] (SELECTQ COMPARESOURCES-BROWSER-TYPE - (OBJECTWINDOW (LET [(WINDOW (OBJ.CREATEW 'VERTICAL NIL TITLE NIL T (FONTPROP - DEFAULTFONT - 'HEIGHT] + (OBJECTWINDOW (LET [(WINDOW (OBJ.CREATEW 'VERTICAL REGION TITLE NIL T + (FONTPROP DEFAULTFONT 'HEIGHT] (WINDOWPROP WINDOW 'UNDERSCONTRUCTION T) (GETPROMPTWINDOW WINDOW T) (WINDOWPROP WINDOW 'UNDERSCONTRUCTION NIL) - (PROG1 (COMPARESOURCES FILEX FILEY '(T 2WINDOWS) - DW? WINDOW) - (OPENW WINDOW)))) - (TEDIT [LET ((TSTREAM (OPENTEXTSTREAM))) + (COMPARESOURCES FILEX FILEY '(T 2WINDOWS) + DW? WINDOW) + (OPENW WINDOW) + WINDOW)) + (TEDIT (LET ((TSTREAM (OPENTEXTSTREAM))) (DSPFONT DEFAULTFONT TSTREAM) - (PROG1 (COMPARESOURCES FILEX FILEY EXAMINE DW? TSTREAM) - [TEDIT TSTREAM NIL NIL `(READONLY T WINDOWTYPE COMPARESOURCES-TEDIT - TITLE ,TITLE] - (CL:WHEN NIL - EXAMINE - (COMPARESOURCES FILEX FILEY EXAMINE DW? (OPENSTREAM '{NULL} - 'OUTPUT))))]) + (COMPARESOURCES FILEX FILEY EXAMINE DW? TSTREAM) + [TEDIT TSTREAM REGION NIL `(READONLY T WINDOWTYPE COMPARESOURCES-TEDIT TITLE + ,TITLE] + (CL:WHEN NIL + EXAMINE + (COMPARESOURCES FILEX FILEY EXAMINE DW? (OPENSTREAM '{NULL} 'OUTPUT))) + (WFROMDS TSTREAM))) (HELP]) ) @@ -689,16 +690,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 (1920 27703 (COMPARESOURCES 1930 . 8443) (\CS.COMPARE.MASTERS 8445 . 16581) ( -\CS.COMPARE.TYPES 16583 . 19721) (\CS.EXAMINE 19723 . 23950) (\CS.FIXFNS 23952 . 25454) ( -\CS.SORT.DECLARES 25456 . 25799) (\CS.SORT.DECLARE1 25801 . 27221) (\CS.FILTER.GARBAGE 27223 . 27701)) - (27704 31684 (\CS.ISFNFORM 27714 . 27982) (\CS.COMPARE.FNS 27984 . 28226) (\CS.FNSID 28228 . 28372) ( -\CS.ISVARFORM 28374 . 28479) (\CS.COMPARE.VARS 28481 . 29143) (\CS.ISMACROFORM 29145 . 29283) ( -\CS.ISRECFORM 29285 . 29378) (\CS.ISCOURIERFORM 29380 . 29480) (\CS.ISTEMPLATEFORM 29482 . 29580) ( -\CS.COMPARE.TEMPLATES 29582 . 29947) (\CS.ISPROPFORM 29949 . 30104) (\CS.PROP.NAME 30106 . 30251) ( -\CS.COMPARE.PROPS 30253 . 30410) (\CS.ISADDVARFORM 30412 . 30505) (\CS.COMPARE.ADDVARS 30507 . 30672) -(\CS.ISFPKGCOMFORM 30674 . 30881) (\CS.COMPARE.FPKGCOMS 30883 . 31090) (\CS.COMPARE.DEFINE-FILE-INFO -31092 . 31682)) (31685 38243 (CSOBJ.CREATE 31695 . 32108) (CSOBJ.DISPLAYFN 32110 . 32863) ( -CSOBJ.IMAGEBOXFN 32865 . 35026) (CSOBJ.BUTTONEVENTINFN 35028 . 37993) (CSOBJ.COPYBUTTONEVENTINFN 37995 - . 38241)) (39107 42184 (CSBROWSER 39117 . 42182))))) + (FILEMAP (NIL (1768 27559 (COMPARESOURCES 1778 . 8291) (\CS.COMPARE.MASTERS 8293 . 16437) ( +\CS.COMPARE.TYPES 16439 . 19577) (\CS.EXAMINE 19579 . 23806) (\CS.FIXFNS 23808 . 25310) ( +\CS.SORT.DECLARES 25312 . 25655) (\CS.SORT.DECLARE1 25657 . 27077) (\CS.FILTER.GARBAGE 27079 . 27557)) + (27560 31540 (\CS.ISFNFORM 27570 . 27838) (\CS.COMPARE.FNS 27840 . 28082) (\CS.FNSID 28084 . 28228) ( +\CS.ISVARFORM 28230 . 28335) (\CS.COMPARE.VARS 28337 . 28999) (\CS.ISMACROFORM 29001 . 29139) ( +\CS.ISRECFORM 29141 . 29234) (\CS.ISCOURIERFORM 29236 . 29336) (\CS.ISTEMPLATEFORM 29338 . 29436) ( +\CS.COMPARE.TEMPLATES 29438 . 29803) (\CS.ISPROPFORM 29805 . 29960) (\CS.PROP.NAME 29962 . 30107) ( +\CS.COMPARE.PROPS 30109 . 30266) (\CS.ISADDVARFORM 30268 . 30361) (\CS.COMPARE.ADDVARS 30363 . 30528) +(\CS.ISFPKGCOMFORM 30530 . 30737) (\CS.COMPARE.FPKGCOMS 30739 . 30946) (\CS.COMPARE.DEFINE-FILE-INFO +30948 . 31538)) (31541 37731 (CSOBJ.CREATE 31551 . 31964) (CSOBJ.DISPLAYFN 31966 . 32719) ( +CSOBJ.IMAGEBOXFN 32721 . 34882) (CSOBJ.BUTTONEVENTINFN 34884 . 37481) (CSOBJ.COPYBUTTONEVENTINFN 37483 + . 37729)) (38595 41299 (CSBROWSER 38605 . 41297))))) STOP diff --git a/lispusers/COMPARESOURCES.LCOM b/lispusers/COMPARESOURCES.LCOM index 8b8d106d1524c54dc80e773aba05d15e3d5789c8..8df19dbfd6efaa41d0ae4a44959086f62c51e863 100644 GIT binary patch delta 2577 zcmZuzy>A>v6u-SV!m&wYN4618K#!xqPPEp}%zmCA@%nbox6bX(Wp~f#5Q_kbg^e6L zic=sVbW#-260!mcN}7};hJq?B^b`~n2nmTY{0F?5-Lo&TUF^MiGjHbizJAZoA83Dl zsXgpnq?W$&(T+|HN`csQ!>SXr26MHWySMLbZExIy-5sdG=TY>$4{-Cnh^1pH%Q~aZG+c zuBe4yEUNn#&Mb}eT?5t|=>lK#qcG+`499@>YP*w!afU0?g^VY-lCl9(O;9B6OIC(^ zXyv)~z{qpl(#CN-SdSYbZcuP+l#56E>Q%=k&=66_Pk1{_vlJYY46bk(I}oWgxQ$RH zWpOtG+jB~_?V3Ys1X*IY$pE^AXG^7ph#EKB^^|9N5H_1U;cyom|dWo_zV+!SC^wciZansExu99~i7 zT5+cyHi0mSzKxmSqpA zEizCW6dHbzU`)y3zKMqmGZV|>;5L&D)YPU>SAK;uWP0pJ9D`{f(Zg1?|+gqrCV=zGaSOYSTWo`^@f_@2VV_-Yh;Q>5c({-JHcIWQK z-rm;k&R)HS+{E^;&y1YA?i&V%wH~-*b0HYen}^C-WCd+ev4SFnQ<5eoDs#v|jkZX6 z4-vvL&w61Th+a39OdvXl+=7xYik+O3x7RQw#R@vo3|qM)Qj|RqODhRqmPOnF?8z`| zb8KG>h7t*iwv46JSyGT16J)YbVEJQmabf+{N~Jo4bn>lg>!%ahr3 z6UFbdp~s(IiGDs2tD`&Bwe4GSr4Il1X#3myJKDqO8@2gBebq-yZEl@@MLxMXJBzRN zD-~t&)s=P>i!)+EOcmQVW(o{qW?Y^w7V3&E3_+zLW+pZBMRKTPUU^ymgl+Yiq{I{- zU0CX7nTYu+5+l-9TvRo~CRZq$F))H%R*bWOi^w+_hKSlGw0RS~uv|#Ob&KcBFFnY{W;<%+j9 zw=$LB{7?J6cftv!eg3ql)=90Jt*DY)^jDWwPM?&CUE!PgqEqXyD653SK&e+#|D7lnwF*&RL0|#bucDY4>qoj$_&S zm>^kAYTB3Y>V-25hh&j5)%y(T3LytFCzv~H;4(VjjRT&fI4-lK+bG8)Jw{8gxL0|S Rg$+L!-kN6aKlXkd{U2BEVpISC delta 2281 zcmb7FO>Em_7_QR}y6mr|oq)1Q?=lHmkc+?1pMSM=brYv`>)63|nhp(V)e=Y`O{=Cz zOcM&45a(@{5La$ox58mUs0S{)0SBbQi3?ZM331^9@8>xE*$~ovu;1_X`}@2<-*2A@ zd!Gt-su9TI;%Zx@5~U#NCX-BA&%tEw#`@YuvsJIbdK+?(y;TU8KE71x)HgdbAFOV) zR@*b~`i<4r%v!zHs^65Sm6^4hV(%~$e%K@9M!}^{RT&k03oKLnha5UCXiaq&c=rc zo_&w;55n<`q-_5xbWaS=O&l8-94!xR-#Rrn)KwT<%ZJnUidAwv8;HahxXW%iaJ&dl zSi8s$@PssBz}W;0gC0>bbb6p;s8V0WP-v>5DKcF1^1hd+pfRNTF1zScla)R;t`kNf zXhi9o&?K!-s)mtTQ*||=BCk>cRU>`2q93poj4_Q|(fffbDBEXZM0wYYe;z)QQRMi? z;qg})rojVCQJapgmhBK2=2Kb7hxk-U z*-TR*ZxsSySfqVDhQd8HhNU`SlRlfuDws*w4o_P2tdfmzFi2DBK}&QUF70a*T~3V> z^-zpN-DgV}RnI^{oVyA-jjvxBe^ZwGRu2H8PxBBN#6i;H>e=&M1UMHp>YX~QZq}i_ zzQvbO5w{XhGY2a6P7ZKSt<~FGooQrf8sMr}0Wt+DLV55L#2LtCL1o6ifP%s~Q55Zu zHa6>>PIJB8L7S8y7i#r)o9%jS`_Hp~PdJ#2o}DaXRN&7o2KGE}k1`k#IgxAQ=wM|N z5*r*eo+Rg~oZuXs5o}N-So}SCV_G>eFp!yjZvdYxe~psCg|7#1-xn?n^W)BS{%#HZ z{{G&*`@+fi9KF&#Zq4>Yg=}j)`M;ZTGJ-#z$z+6Itm9nm?ToOugmAC84PJ$x4$&FDD}@S|+Jqg{S&XC&e8J;*10Fe+rC#RT_RYk6+*)G;o) z*r>%9^;~ynB$44*G6@!Jw+u3l7haAI24>(YIC6zy&_so*l=XZiQ^R`&V=QnmF;0HTBst1*e8C(Wq=eyjeALi@Cs)AhI&jL7 QAH=d*6V&Z5%tyoj0`LJp%K!iX diff --git a/lispusers/COMPARETEXT.LCOM b/lispusers/COMPARETEXT.LCOM index 6933ec89b9f4ae30634b7e0711a61f09fd0e4116..4cc7d40d89e3c9b04f5e6f28bf26917fb2193dcc 100644 GIT binary patch delta 2677 zcmZ`*O>7%Q6wYo)(mEtGO{1nwDX%L834*XQ`{xZ6WMi-6P1n2I^#(VgMHrkmR^6ne zMNlDOIFth%+A`1s7Z5_+Dz%AvK%!JVAoaij1VW`CapVdT5=VG5-Xu;7KCI`>yf<&= zz3+Q(ew+XN*u}~&YCSbmU3!YDlmgKvs5+r#FP)qlw#PuB=H?pJCNz7(urK{;L~YaK zKggt+%e#Hud~HX^DA7&u zO6l>&bH&-VWD2HQY4L7uyUtO?U@Qcf@?C9wFx(go9KTQF#9s#}l?gPfCK zEVC+jK{T6yVT0EtMr^)Q=_IPP_EzTwsZWQZ>rEFEjD!YkM;Gm(tq`#1x`vw;RHl|! zY6~k+fGp(Qf-~zUg)m6QKzg%B?&zEpmlXGv2CChY+xhM08*-)prx{t6?!16sSweY- zSh;)WM&owr&r79u8n=%+wfY~Q+-&TrElGbhE-&uI-_;XB?fOfO_{Hc=Z`iXo=6w*7)mXet971I_m0DVwn%c$gv=;`Tv0IN1HZ@{G3%eE22uTwGnrc9~ z7|#0nAOUJ%+F~avy0O@bQfsS>%B=(f$r6ZNzqMoPh?oQtZt4Lsbin_B0MRKwbaTt8 ziG~~bt`k>~s_K20B1qwTH@7v2!m^j(jUvbzxXv#Z0fLpMJ;e&e&G-e@Pn3#oyq#YN zVW(N_+n$jo;xp%mWw(Ig!2_0@BV}*i1!_~MgmE6IWr6PnID>aWnmQO86^c%|IG)T! zIE^QCe1DxB2>k>TL`)lEfmuXxYeuEuy9Gpf8)?Tf%~5n^gYr5;SOJRHQ5yB71sviI z%IWG#^~6f`^dic-4hp=o_}bFRGf%=|^~@sHrBd8u&@YW3sC7giRQ&hkkO zlxm}aBTTmfXBL-VuP>bdC4&)LLUj~FBub`VHNZ130F|{`Jd#w#^!&=X_ zTVq5KsoWQv%k;9(GFeGuzhn;ft)tC}r^~>GdS8%C_G<5*Oi#Cjg+>}U+{HfZ9ed!; zlKd6B)jM?15nP}8;M6~FpXAk}CGV|^N`mr@=P#E;D9*S3zADxvtZ}>``Rw5b-!+lw zTd7YGq+4lDHGL~Lsm=~(1_ybbw{Tb`d_EyqaMLjIT0+nT4_r7kgJVQ}8c$yQ+X6~- z9^br|U<1f|q+ICJjiZ@aE|XMd#r|hx&1C2MN4HrfsN=?1hJF9&;M$%3ST03CK`_$y z$_ekFSmk*4;v%vb`=b!Y%X6iv&>v5nDbY{=x3fOI4O{6K*cQ84eL$6p?BjuFJKer* z?Ct>F`98vxmq$0@Re|?McI%1VYsSt`B_%?-yFniDie7a{!6`aAUO#Y3F8gt?C|zR@ z?|QOF0Ack}7VkP=Zg0G;ZP7*9O?cFzBt|cy;d0Rn3L#(w(^Vl_Duj_6wB=9N*%L#L z?IBo%g6X6PHUTG?;{|pdyI6f^SPpix!ttVvNq&nm-8Pq3*Q9mV~X#RjSj(n-}m>kCKkcX h>TO~f#ur1-#0UQZU(iR-ot<{KNR0ci_s5)j&b{Y+ z-*@k4XMaEa-rQbAK4w=h9HTNNK*Xd4%|E3kXrY9#S zC8(6ws+FgiYl@UiOk`ZoNe50UbZn5G7LSz$cR&W!w5Y|t6s$c)S6ppM)2B2QZL)!7 zCKG9YwvY;((3uZm$~F@d9!#jfV|b|<$18#Yfs=LpJW$A`in+;fq2K_CEGWoPOOi?G zxhD4X^sygAqraZ$!5=%=OHS47p*}u%wr7G61Kim-++;de%AYKPX@L_2egL|Gp7J)2 z3p)22_cafAHD*;wZPZ}7j! zY9s1K78}!1b6OOIZyRFimy-`qh}dt4r~0}1gT$kU_ZttqKi9pt8V{m4(cd8dcwVfq z@A|)QQrsb))t^h*b|LT!pvV?voe=x8g|Phz=O`3P@hGyQrW~)^ERKPBcw!mVb!Y=+ z4yaDz`~lT8DCYc@Ac~4P_ApEw)Ff@wcxb2)axX6E z3Sg5bz^mqQ$9Nb}<+wxzAaRMB?WkB&g~}Lb3yYI+R%98^t`OXV=NFv}qR^r+o0>1W zryZawg*iX4fl>oJH;*%f0Kz$i$CA6@YEVddUJN=yEeJ8ygsM#l+-xqy{b;~pVLQci z;1)uTNDI%PuDZ5}dtKUMVlGl&{nzAeIUe zT&TUdbZPY{)XtYzYsmHU*Kv{{8KmW<#&xLFFJ7#!RF~HHqykd8(ZC*7Q-amn^40p% zB1j3GARys9j|$bnMPghQ{GuCj*}wzLWiXL;u?&WZ2$>Iy z2%yv~&oE-CUFcFV#-C=yK9TvcPXtlhXv?Q!ZTbYnWXC1@WS1rA?9r}Q*~^0qg2tMI z|bb`jnxSH~{q5?N;T-Hxbh?C$OZO;lW7NKP*#X_xp@Wm8Kj z%6In%IhF}TG#1qjQMZZ7rNX0ITQe*^CR<}gZ}Uze;5ixG7OEfTpAa&6_!Ut#*yZ7g zG4wJaPijDt94}G#7)iE18eSBS|If=QB09gFqE2)@eU6&k$8L?tLY93!@|rj_!2TYg zdu}6)sm=?*FE=1W2PW)$z7_8ISYTtLS)s+wjUL@uiMVj@$Oc;!aMB7!Bru_9v?g_9Ae=MR#Sm9c`n@) zbk*$Ycjh&uR^GSc=LCucW-NMHY%xv4cTAK-ZWf6hs3l6;O!On+3`bvy>6h8bmUn_iR3Vv2i@eCzDKZUpgworBsxk*=P{yCe6Va2 K@7CI3dH5ggDpD2z diff --git a/lispusers/COMPARETEXT.TEDIT b/lispusers/COMPARETEXT.TEDIT index 4c0ff82228448d2d5a42115b45a1b92d955af3d9..bd59a01b3a8a71f79dca91df82ed20695c474849 100644 GIT binary patch delta 204 zcmX?Xbjx_c1PL7l_aMgr57!_ag&B83v5@yYqQ1&KwO#rb&( z<(YXY`Q@Acu$S>ODo-vJ&tue`{75{D(RH$~#N^355?qWnlP^l-vhHCBt=a_uyg)`k delta 72 zcmca*eAsBh1YtcNXMbNE1@|Dw01ww7FmL0Eb~5%^2ta diff --git a/lispusers/EXAMINEDEFS b/lispusers/EXAMINEDEFS index b17c568b..31ab7fc0 100644 --- a/lispusers/EXAMINEDEFS +++ b/lispusers/EXAMINEDEFS @@ -1,22 +1,28 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 2-Jan-2022 23:15:58"  -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>EXAMINEDEFS.;19 6871 +(FILECREATED "25-Jan-2022 10:20:31"  +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>EXAMINEDEFS.;31 11252 :CHANGES-TO (FNS EXAMINEFILES) - :PREVIOUS-DATE "30-Dec-2021 21:49:58" -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>EXAMINEDEFS.;18) + :PREVIOUS-DATE "23-Jan-2022 17:41:43" +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>EXAMINEDEFS.;30) (PRETTYCOMPRINT EXAMINEDEFSCOMS) -(RPAQQ EXAMINEDEFSCOMS ((FNS EXAMINEDEFS EXAMINEFILES) - (INITVARS (EXAMINEDEFS-PROCESS-LIST)))) +(RPAQQ EXAMINEDEFSCOMS ((FNS EXAMINEDEFS EXAMINEFILES TEDITDEF) + (INITVARS (EXAMINEDEFS-PROCESS-LIST) + (EXAMINEWITH 'COMPARETEXT)) + (FILES (SYSLOAD) + COMPARETEXT))) (DEFINEQ (EXAMINEDEFS - [LAMBDA (NAME TYPE SOURCE1 SOURCE2 TITLE1 TITLE2 REGION) (* ; "Edited 24-Dec-2021 22:39 by rmk") + [LAMBDA (NAME TYPE SOURCE1 SOURCE2 TITLE1 TITLE2 REGION) (* ; "Edited 23-Jan-2022 17:40 by rmk") + (* ; "Edited 18-Jan-2022 22:40 by rmk") + (* ; "Edited 12-Jan-2022 17:29 by rmk") + (* ; "Edited 24-Dec-2021 22:39 by rmk") (* ; "Edited 20-Dec-2021 11:06 by rmk") (* ;; "This provides for side-by-side examination of separate but presumably related expressions. The (LISTP) expressions can be provided directly as SOURCE1 and SOURCE2 or, if NAME is given the copies of the definitions of NAME as TYPE on the two sources are examined.") @@ -30,6 +36,8 @@ (ERROR SOURCE1 " cannot be examined")) (CL:UNLESS (LISTP SOURCE2) (ERROR SOURCE2 " cannot be examined"))) + (CL:UNLESS TYPE + (SETQ TYPE 'FNS)) (* ;; "TITLE1 and TITLE2 are optional strings that will be used to construct the titles of the SEDIT windows. We would like to know where GETDEF got the definition so we can use that, but there isn't an interface that provides that information (extended WHEREIS?)") @@ -68,65 +76,124 @@ (* ;;  "Crude suggestions for height, width, position. Suggest shorter window for smaller structures") - (CL:UNLESS (REGIONP REGION) - (SETQ REGION (GETREGION))) - (LET (W1 W2 HALFWIDTH) - (SETQ HALFWIDTH (IQUOTIENT (FETCH (REGION WIDTH) OF REGION) - 2)) - [SETQ W1 - (SEDIT:GET-WINDOW (SEDIT:SEDIT DEF1 - `(:NAME ,(CONCAT NAME " from " TITLE1) - :REGION - ,(CREATE REGION - USING REGION WIDTH _ HALFWIDTH) - :DONT-KEEP-WINDOW-REGION T] - [SETQ W2 - (SEDIT:GET-WINDOW - (SEDIT:SEDIT DEF2 - `(:NAME ,(CONCAT NAME " from " TITLE2) - :REGION - ,(CREATE REGION USING REGION LEFT _ - (IPLUS (FETCH (REGION LEFT) - OF REGION) - HALFWIDTH) - WIDTH _ HALFWIDTH) - :DONT-KEEP-WINDOW-REGION T] + (SELECTQ EXAMINEWITH + (SEDIT (CL:UNLESS (REGIONP REGION) + (SETQ REGION (GETREGION))) + [LET (R1 R2 HALFWIDTH W1 W2) + (SETQ HALFWIDTH (IQUOTIENT (FETCH (REGION WIDTH) + OF REGION) + 2)) + (SETQ R1 (CREATE REGION USING REGION WIDTH _ HALFWIDTH)) + (SETQ R2 (CREATE REGION USING REGION LEFT _ + (IPLUS (FETCH (REGION LEFT) + OF REGION) + HALFWIDTH) + WIDTH _ HALFWIDTH)) + [SETQ W1 + (SEDIT:GET-WINDOW (SEDIT:SEDIT + DEF1 + `(:NAME ,(CONCAT NAME " from " TITLE1) + :REGION + ,(CREATE REGION + USING REGION WIDTH _ + HALFWIDTH) + R1 :DONT-KEEP-WINDOW-REGION T] + [SETQ W2 + (SEDIT:GET-WINDOW (SEDIT:SEDIT + DEF2 + `(:NAME ,(CONCAT NAME " from " TITLE2) + :REGION + ,R2 :DONT-KEEP-WINDOW-REGION T] + (ATTACHWINDOW W2 W1 'RIGHT 'JUSTIFY) + (MODERNWINDOW W2) - (* ;; + (* ;;  "So we can kill the processes on the next call, if they still exist after the windows are closed.") - [PUSH EXAMINEDEFS-PROCESS-LIST (CONS W1 (WINDOWPROP W1 'PROCESS)) - (CONS W2 (WINDOWPROP W2 'PROCESS] - (ATTACHWINDOW W2 W1 'RIGHT 'JUSTIFY) - (MODERNWINDOW W2))) + (PUSH EXAMINEDEFS-PROCESS-LIST (CONS W1 (WINDOWPROP + W1 + 'PROCESS)) + (CONS W2 (WINDOWPROP W2 'PROCESS]) + (COMPARETEXT [LET (COMPARETEXT.ALLCHUNKS CTWINDOW + (KEY (LIST NAME TYPE SOURCE1 SOURCE2 TITLE1 + TITLE2))) + (DECLARE (SPECVARS COMPARETEXT.ALLCHUNKS)) + (* ; "Reuse an existing CT graph window") + (OR [FIND W IN (OPENWINDOWS) + SUCHTHAT (EQUAL KEY (WINDOWPROP W + 'EXAMINEDEFS] + (PROG1 (SETQ CTWINDOW + (COMPARETEXT (TEDITDEF NAME DEF1 TYPE) + (TEDITDEF NAME DEF2 TYPE) + 'LINE REGION (LIST TITLE1 TITLE2) + (CONCAT "Compare sources of " NAME + " as " TYPE))) + (WINDOWPROP CTWINDOW 'EXAMINEDEFS + (LIST NAME TYPE SOURCE1 SOURCE2 TITLE1 + TITLE2)))]) + (SHOULDNT))) (PROGN (EDITE DEF1) (EDITE DEF2]) (EXAMINEFILES - [LAMBDA (FILE1 FILE2 TITLE1 TITLE2 REGION) (* ; "Edited 2-Jan-2022 23:15 by rmk") + [LAMBDA (FILE1 FILE2 TITLE1 TITLE2 REGION) (* ; "Edited 25-Jan-2022 10:08 by rmk") + (* ; "Edited 2-Jan-2022 23:15 by rmk") (* ; "Edited 30-Dec-2021 21:49 by rmk") (* ;; "We get a region, then split it in half. Should we attach or at least co-move and co-close the 2 windows?") (CL:UNLESS REGION (SETQ REGION (GETREGION))) - (TEDIT-SEE FILE1 (RELCREATEREGION `(,REGION 0.5 -1) - REGION - 'RIGHT - 'TOP - `(,REGION 0.5) - (FETCH (REGION TOP) OF REGION)) - NIL TITLE1) - (TEDIT-SEE FILE2 (RELCREATEREGION `(,REGION 0.5 1) - REGION - 'LEFT - 'TOP - `(,REGION 0.5) - (FETCH (REGION TOP) OF REGION)) - NIL TITLE2]) + (LIST (TEDIT-SEE FILE1 (RELCREATEREGION `(,REGION 0.5 -1) + REGION + 'RIGHT + 'TOP + `(,REGION 0.5) + (FETCH (REGION TOP) OF REGION)) + NIL TITLE1) + (TEDIT-SEE FILE2 (RELCREATEREGION `(,REGION 0.5 1) + REGION + 'LEFT + 'TOP + `(,REGION 0.5) + (FETCH (REGION TOP) OF REGION)) + NIL TITLE2]) + +(TEDITDEF + [LAMBDA (NAME DEF TYPE READERENVIRONMENT) (* ; "Edited 12-Jan-2022 17:27 by rmk") + (LET ((TSTREAM (OPENTEXTSTREAM))) + (DSPFONT DEFAULTFONT TSTREAM) + (CL:WHEN (EQ (CAR DEF) + 'DEFINEQ) + (SETQ DEF (CADR DEF))) + (IF (EQ NAME (CAR DEF)) + THEN (DSPFONT BOLDFONT TSTREAM) + (PRINT NAME TSTREAM) + (DSPFONT DEFAULTFONT TSTREAM) + (SETQ DEF (CADR DEF)) + (PRINTDEF DEF 3 T NIL NIL TSTREAM) + ELSEIF (EQ NAME (CADR DEF)) + THEN + (* ;; "Presumably a DEFUN. Print the CAR, boldface the cadr") + + (PRINTOUT TSTREAM "(" .P2 (CAR DEF) + " " .FONT BOLDFONT .P2 (CADR DEF) + .FONT DEFAULTFONT " " .P2 (CADDR DEF) + T 3) + (PRINTDEF (CDDDR DEF) + 3 T T NIL TSTREAM) + (PRIN3 ")" TSTREAM) + ELSE (PRINTDEF DEF 3 NIL NIL NIL TSTREAM)) + TSTREAM]) ) (RPAQ? EXAMINEDEFS-PROCESS-LIST ) + +(RPAQ? EXAMINEWITH 'COMPARETEXT) + +(FILESLOAD (SYSLOAD) + COMPARETEXT) (DECLARE%: DONTCOPY - (FILEMAP (NIL (510 6809 (EXAMINEDEFS 520 . 5811) (EXAMINEFILES 5813 . 6807))))) + (FILEMAP (NIL (662 11110 (EXAMINEDEFS 672 . 8791) (EXAMINEFILES 8793 . 9988) (TEDITDEF 9990 . 11108))) +)) STOP diff --git a/lispusers/EXAMINEDEFS.LCOM b/lispusers/EXAMINEDEFS.LCOM index d2963945990761e7069a2ad221872ff9eafa0b60..29be30c65641cb740fb8f172718c78c299251d43 100644 GIT binary patch literal 3625 zcmb_fO>7&-6&9&BahcSR9K#5NLU<+mLmo(Q_J@BhR1SBC;##ZS)$Y=?TB8Cb(v?t2 zG^7|vQ1p^q0wjkX8UsOZz2uOK6+_2@=U#F)kX!Bnd?>GND!+ObGd@F zU_mSvHsv+5ba!xC(khw;c2lb~b(W_>{$PCa=;(Mfr12@`DfcHk+WPaad*`FG^Nl|a z9vu%(H{9{T;CSO?G&~-?r@bI1SgM@~?DO#D2!re%Q>^ znyd!<`)8xsj-z)Uot^)@NvX1QH=-lB(doG^%^N6}%Xu0O-hrFf7}oTB@jIRNdpaF4 zrkNTwtuFUAMO2D?Ds;Sva`Oi%QZop}J;(1wB^yrw$MvflVYQ~gnuh*;-8kNR?g^-A z*K>t{Se5#O!5}N{JD%;Ul}?tw9q>@Z;(lD_u4{FB-c}?9HQExpa>A&u$+1FxhOt3i z?soc)9e1&+Qz)4=3MH>f0e3=77~%OPqar7a9I!&M>G&R|CdE$d3Jp^unMwhjBEJ_} zimat`NoN%A1_F}`d3;+?hgfYICNjoKLFii|ib}|ZSaR!AZr_Q!MauqdHM{hB>lw9| zKW~qh@XN{1#9IE`np^VE{vgTw*~uzp+RK;A?_Xp-Z1MIRl6rZwr9_j}eJf!PTHIP- zC#zli*<0-=?V;X!arwGZ+rKdp&)%}0So5^p;_mNQ!@^l=k18tOjp%vf0dW_N%>HolGa2@o!O57qe3@|u5V zHtpxv)(-M3igWSpvvmA8^ZSgNe(|>V5BKus_Tk!t-%ajje|z!mm)pO1@buqaRW+@{PpF_`0&=H-|BMZealHkrP@&{>Lke(apm)m zUz48i{Umvm1=GsLWF@ml6aQ_WlofSd|9axn<)=qapZM$9z4fObDF;@%%27vsSC$IZ zszJhbfD2UAXGYtuuF#CNGF;>4;(M* zg(3wNgXu3*Dkg3Fwg}TLNN?1M$1%6Msg4dmBk5cdr!38gKm0xvo0P%{v zR$GwQ>e5+tcnu!Fatc7K(MYifI0d89kn|4-S0xdKen<^X%FC;&nJKBtrX-!EBtWVX zN5QFTkh`jTWWvJ2+BC^UQ6!^Lg;z7k#a-xhw-?1uXP5Lk(A3%N#yD$@nyI_GQK6|k_Gnr z2*X0t_Pw~YB}9g-B`83xKZ`U}$XC@<3m zIuBN0i4&k1YimtkZg~~3w1>SSx4x$jXT%)${+H!&W|2mUh`ay!=nWdes z!dISASNY--p3R_iw}w3P;)`ES!h}0%rDG~RQBudtM~4?nf5BYVh!4~&rgA)!PUeYI zV^Da>+`JUWgQx5S-Y3V)hux$wfS1Lt!^3V84wE^>k2&Oq!<5s-V`~89AVhmF@kguF z)j}r*{sxws=$^c!G0TGQYFaX-AMrA4j zut`V=EjtR70idO%#i#@`8am1;+faoHHbI(anC6cV4hG>xrj_1VpcnFm_ z>4g>&Leu_PHjq@<>G>$lbD&);LME|Xh;}2_=XUWWe&XnFrf%R07W>rnBr}2kxl{6A OM(sh@ZJz%5cr7EE@t)1E5n`l_O({`cVt=q-LghY{oF<@&5o-xLw zF_QTMI4X$;NYtwy^>5&Bzs}xQH=e z(Lk~xYdh<~Wu)gIdoGC$SvHWebC|z(7B3VES!gY9t+xKh$2gngXUcYslssbk#JWK0 zy-1I^$`H~)(Nsh~a7Yk~d24kg918(PhNQExLeedy<#@7a)@_Gaq}&9<()gJM=ukCl z<-oT5Dl|ZY0JBSlfPRdvb4B_sl^F!?JI~Q-{MyJkaChUM=v z2;=6ZxhOI4bADn)C?^Nlc|RQ5$D?1zi^*~<#%;t7A5PH4#O&ml{Ul7yc0x-=LK^|} zPGXY2P6*YsJJyPN{3vAH^r;&NnaqmdvTQ_;%xGBcrXzOO9-JIT(ZR_lni|Y(AJ?as z_K%%d1nwVIqucHl49rNf2*k2|0+OWmJy8dX)CvvHEsaImRC$JsM4M0>CFn!-FRU=@VA(945w$ohjNS`CB7ZI#NGaSUI5I^6iF>!Ul z$O2ZwN1c-C1D5rF`B;|D^N|Gey#k~mV68n;v0Vp{Dnr+80FrRDc(?`V3J}k8JRu`_xTM(=VwT3CFJSe*koe=iLAR diff --git a/lispusers/EXAMINEDEFS.TEDIT b/lispusers/EXAMINEDEFS.TEDIT index ce966800001039f2be2bdfc695be9a6fa4d84947..a0390404ee01e6df0f5f69bc275d471399142826 100644 GIT binary patch delta 1087 zcmZWn!EVz)5UrauidxY~5pe0D1FBFWC6+iLfqDqVfDdV^)D;z+Hukz%b>ofJ4kk#* z66YdO{103>p@<7NE}ZxP4sho)*jdM}t3=vp_U+7jZ)W@x{@(j|arx;>LgAbR9ta;? zF_{v{LJ(qf3lIz9@&!*MZ-ZIrv(^_#VS%6B)l%&M#ih$3-!Exms zLyLqkr4o*wcJ)IWNZ=*QMXA!5MdPvq6CCBBY-uFb1txSz#6H!%tUtVI4wo>?ds z`~~tda8RX1~_$f>O$y&SocN>3V=TPW%hWP6uq7HqpK$c-Gy*@|jC2K+0KZ>iY6 VmHuk%H<5iGD^*axvqs;3{|~z>2V4LE delta 273 zcmcbsc1&SH&*W>Yd=sZE-u#5In{o0DmTA(73Pq{unfZANL9Xte{(cIX#R>&Q`DK|Y zsVS2iSUs6bGEyhjiSd?a=Hw_8XCxM->M1BpHfHl>4R&?$44K@`7Bu-DoAl;iY=Vqj z|Nk@mf3FB67$(azifvZpILIL(!2kqoK+FnaFafb1h`~Dfg+MN2^W+VJN=ytVC)*2! z>rDrVgA_1=7$D^!ZD0`_5CbFvHzap5m$0KPNToVR4x|kz#{_2Z!bG@146qiUIM`GO L&3c2uuWAkaplan>Local>medley3.5>my-medley>lispusers>GITFNS.;35 57074 + + :CHANGES-TO (FNS GIT-COMPARE-WITH-MYMEDLEY) + + :PREVIOUS-DATE "26-Jan-2022 22:40:03" +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>GITFNS.;34) + + +(PRETTYCOMPRINT GITFNSCOMS) + +(RPAQQ GITFNSCOMS + ( + (* ;; "Set up") + + (FILES (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES) + COMPAREDIRECTORIES COMPARESOURCES COMPARETEXT PSEUDOHOSTS) + (INITVARS [GITMEDLEYDIR (OR (UNIX-GETENV "GITMEDLEYDIR") + (CONCAT "{UNIX}" (SLASHIT (PACKFILENAME 'HOST NIL 'BODY MEDLEYDIR + ) + T] + (MYMEDLEYHOST 'MM) + (GITMEDLEYHOST 'GIT)) + (INITVARS (GIT-IGNORE-FILES '(EXPORTS.ALL RDSYS RDSYS.LCOM)) + (GIT-IGNORE-DIRECTORIES '(LOADUPS PATCHES TMP FONTSOLD DELETED)) + (GIT-MERGE-COMPARES T)) + (P (PSEUDOHOST MYMEDLEYHOST MEDLEYDIR) + (PSEUDOHOST GITMEDLEYHOST GITMEDLEYDIR)) + + (* ;; "") + + + (* ;; "Lisp exec commands") + + (COMMANDS gmc bbc prc cob b?) + + (* ;; "") + + + (* ;; "File correspondents") + + (FNS TOGIT FROMGIT GIT-DELETE-FILE MYMEDLEY-DELETE-FILES) + (FNS MEDLEYSUBDIR GITSUBDIR STRIPDIR STRIPHOST) + (FNS GFILE4MFILE MFILE4GFILE GIT-REPO-FILENAME) + (FNS MEDLEYSUBDIRS GITSUBDIRS) + (VARS (MEDLEYSUBDIRS (MEDLEYSUBDIRS)) + (GITSUBDIRS (GITSUBDIRS))) + + (* ;; "") + + + (* ;; "Git commands") + + (FNS GIT-COMMIT GIT-PUSH GIT-PULL GIT-BRANCH-DIFF GIT-APPROVAL GIT-GET-FILE GIT-FILE-EXISTS? + GIT-REMOTE-UPDATE GIT-FILE-DATE) + + (* ;; "") + + + (* ;; "Branches") + + (FNS GIT-CHECKOUT GIT-WHICH-BRANCH GIT-MAKE-BRANCH GIT-BRANCHES GIT-BRANCH-EXISTS?) + + (* ;; "My branches") + + (FNS GIT-MY-CURRENT-BRANCH GIT-MY-BRANCHP GIT-MY-NEXT-BRANCH GIT-MY-BRANCHES) + + (* ;; "") + + + (* ;; "Worktrees") + + (FNS GIT-ADD-WORKTREE GIT-REMOVE-WORKTREE GIT-LIST-WORKTREES WORKTREEDIR) + + (* ;; "") + + + (* ;; "Comparisons") + + (FNS GIT-GET-DIFFERENT-FILES GIT-COMPARE-BRANCHES GIT-COMPARE-WITH-MYMEDLEY + GIT-COMPARE-WORKTREE GITCDOBJBUTTONFN GIT-CD-LABELFN GIT-CD-MENUFN) + + (* ;; "") + + + (* ;; "Utilities") + + (FNS CDGITDIR GIT-COMMAND GITORIGIN GIT-INITIALS))) + + + +(* ;; "Set up") + + +(FILESLOAD (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES) + COMPAREDIRECTORIES COMPARESOURCES COMPARETEXT PSEUDOHOSTS) + +(RPAQ? GITMEDLEYDIR (OR (UNIX-GETENV "GITMEDLEYDIR") + (CONCAT "{UNIX}" (SLASHIT (PACKFILENAME 'HOST NIL 'BODY MEDLEYDIR) + T)))) + +(RPAQ? MYMEDLEYHOST 'MM) + +(RPAQ? GITMEDLEYHOST 'GIT) + +(RPAQ? GIT-IGNORE-FILES '(EXPORTS.ALL RDSYS RDSYS.LCOM)) + +(RPAQ? GIT-IGNORE-DIRECTORIES '(LOADUPS PATCHES TMP FONTSOLD DELETED)) + +(RPAQ? GIT-MERGE-COMPARES T) + +(PSEUDOHOST MYMEDLEYHOST MEDLEYDIR) + +(PSEUDOHOST GITMEDLEYHOST GITMEDLEYDIR) + + + +(* ;; "") + + + + +(* ;; "Lisp exec commands") + + +(DEFCOMMAND gmc (SUBDIR . OTHERS) + + (* ;; "Compares the specified local git-medley subdirectories against my working Medley. ") + + (GIT-COMPARE-WITH-MYMEDLEY (AND SUBDIR (CONS SUBDIR OTHERS)) + NIL NIL NIL NIL T)) + +(DEFCOMMAND bbc (BRANCH1 BRANCH2 LOCAL) + + (* ;; "Compares 2 git branches. Defaults to local/ if LOCAL, otherwise defaults to origin/. BRANCH2 defaults to master (origin/ or local/ depending on LOCAL)") + + (GIT-COMPARE-BRANCHES BRANCH1 BRANCH2 LOCAL)) + +(DEFCOMMAND prc (REMOTEBRANCH) + + (* ;; "Compares REMOTEBRANCH against origin/master, for pull-request assessment") + + (CL:UNLESS REMOTEBRANCH (ERROR "PR branch not specified" "")) + (GIT-COMPARE-BRANCHES REMOTEBRANCH 'origin/master NIL)) + +(DEFCOMMAND cob (BRANCH) + + (* ;; "Switches to BRANCH. Defaults to my current branch, T means my next branch (under wherever we are now ") + + (SELECTQ (U-CASE BRANCH) + (NIL (GIT-CHECKOUT (GIT-MY-CURRENT-BRANCH))) + ((T NEW) + (GIT-MAKE-BRANCH)) + (GIT-CHECKOUT BRANCH))) + +(DEFCOMMAND b? (BRANCH) (GIT-WHICH-BRANCH)) + + + +(* ;; "") + + + + +(* ;; "File correspondents") + +(DEFINEQ + +(TOGIT + [LAMBDA (MFILES) (* ; "Edited 19-Jan-2022 23:35 by rmk") + (* ; "Edited 18-Jan-2022 16:33 by rmk") + (* ; "Edited 13-Jan-2022 15:47 by rmk") + + (* ;; "Copies MFILES to {GIT}. We do a sanity check to make sure particular MFILE is the latest version--we may have created another one without revising the directory browser.") + + (CL:WHEN (EQ 'master (GIT-WHICH-BRANCH)) + (ERROR "Can't copy to the master branch")) + (FOR MF GF DEST INSIDE MFILES COLLECT (SETQ MF (OR (FINDFILE MF NIL MEDLEYSUBDIRS) + (ERROR "FILE NOT FOUND" MF))) + (CL:UNLESS (STRING.EQUAL MF (INFILEP (PACKFILENAME + 'VERSION NIL + 'BODY MF)) + FILEDIRCASEARRAY) + (FLASHWINDOW T) + (PRIN3 (CONCAT MF " is not the latest version!") + T) + (ERROR!)) + (SETQ GF (GFILE4MFILE MF)) + (PRIN3 (IF (SETQ DEST (COPYFILE MF GF)) + THEN (CONCAT "Copied to " GF) + ELSE (FLASHWINDOW T) + (CONCAT MF " cannot be copied")) + T) + DEST]) + +(FROMGIT + [LAMBDA (GFILES) (* ; "Edited 18-Jan-2022 16:31 by rmk") + (FOR GF MF DEST INSIDE GFILES COLLECT (SETQ GF (OR (FINDFILE GF NIL GITSUBDIRS) + (ERROR "FILE NOT FOUND" GF))) + (SETQ MF (MFILE4GFILE GF)) + (PRIN3 (IF (SETQ DEST (COPYFILE GF MF)) + THEN (CONCAT "Copied to " DEST) + DEST + ELSE (FLASHWINDOW T) + (CONCAT GF " cannot be copied")) + T) + DEST]) + +(GIT-DELETE-FILE + [LAMBDA (FILE) (* ; "Edited 18-Jan-2022 23:07 by rmk") + (* ; "Edited 19-Dec-2021 16:11 by rmk") + (* ; "Edited 16-Dec-2021 13:00 by rmk") + + (* ;; "This deletes a file in the local checkout git directory {UNIX}... FILE has to already be a full file name, for safety.") + + (* ;; "Since git files are on UNIX, we don't have to worry about older version numbers. ") + + (* ;; "We could make this undoable by copying it to deleted/, but git also can restore.") + + (CL:UNLESS (OR (EQ GITMEDLEYHOST (FILENAMEFIELD FILE 'HOST)) + (STRPOS GITMEDLEYDIR FILE 1 NIL T NIL FILEDIRCASEARRAY)) + (ERROR "NOT A GIT-CLONE FILE" FILE)) + (DELFILE FILE]) + +(MYMEDLEY-DELETE-FILES + [LAMBDA (FILE) (* ; "Edited 18-Jan-2022 23:02 by rmk") + (* ; "Edited 19-Dec-2021 23:33 by rmk") + + (* ;; "FILE is presumably the latest version of a file in the MyMedley directory, and we are presumably removing all versions of that file. If we left older versions, we would really trash ourselves.") + + (* ;; "But to guard against mistakes, %"deletion%" consists of moving all versions of the file from its current location to a deleted/ subdirectory of MEDLEYDIR, one that does not correspond to a git subdirectory.") + + (SETQ FILE (CONTRACT.PH FILE MYMEDLEYHOST)) + (CL:WHEN (EQ MYMEDLEYHOST (FILENAMEFIELD FILE 'HOST)) + (FOR F IN (DREVERSE (FILDIR (PACKFILENAME 'VERSION '* 'BODY FILE))) + COLLECT + + (* ;; + "Delete the earlier ones first, if it goes bad, you don't want them to persist") + + (CL:UNLESS (RENAMEFILE F (PACKFILENAME 'DIRECTORY (CONCAT "deleted>" + (FILENAMEFIELD F + 'DIRECTORY)) + 'BODY F)) + (ERROR "Could not delete " F)) + F))]) +) +(DEFINEQ + +(MEDLEYSUBDIR + [LAMBDA (SUBDIR STAR) (* ; "Edited 21-Jan-2022 15:18 by rmk") + (* ; "Edited 18-Jan-2022 16:19 by rmk") + (PACKFILENAME 'HOST MYMEDLEYHOST 'BODY (CONCAT SUBDIR (CL:IF STAR + ">*" + "")]) + +(GITSUBDIR + [LAMBDA (SUBDIR STAR) (* ; "Edited 21-Jan-2022 15:18 by rmk") + (* ; "Edited 18-Jan-2022 16:19 by rmk") + (* ; "Edited 30-Oct-2021 23:59 by rmk:") + (SLASHIT (PACKFILENAME 'HOST GITMEDLEYHOST 'BODY (CONCAT SUBDIR (CL:IF STAR + "/*" + "")]) + +(STRIPDIR + [LAMBDA (FILE DIRECTORY) (* ; "Edited 18-Jan-2022 16:09 by rmk") + (* ; "Edited 8-Nov-2021 11:50 by rmk:") + (IF (STRPOS DIRECTORY FILE 1 NIL T NIL FILEDIRCASEARRAY) + THEN (SUBSTRING FILE (ADD1 (NCHARS DIRECTORY))) + ELSE FILE]) + +(STRIPHOST + [LAMBDA (NAME) (* ; "Edited 18-Jan-2022 15:37 by rmk") + (LET ((POS (STRPOS "}" NAME))) + (CL:IF POS + (SUBSTRING NAME (ADD1 POS)) + NAME)]) +) +(DEFINEQ + +(GFILE4MFILE + [LAMBDA (MFILE) (* ; "Edited 18-Jan-2022 15:24 by rmk") + (SETQ MFILE (OR (FINDFILE MFILE NIL MEDLEYSUBDIRS) + (ERROR "FILE NOT FOUND" MFILE))) + (SLASHIT [IF (EQ MYMEDLEYHOST (FILENAMEFIELD MFILE 'HOST)) + THEN (PACKFILENAME 'HOST GITMEDLEYHOST 'VERSION NIL 'BODY MFILE) + ELSE (PACKFILENAME 'VERSION NIL 'BODY (CONCAT GITMEDLEYDIR (SUBSTRING + MFILE + (ADD1 (NCHARS MEDLEYDIR] + T]) + +(MFILE4GFILE + [LAMBDA (GFILE) (* ; "Edited 18-Jan-2022 15:24 by rmk") + (UNSLASHIT (IF (EQ GITMEDLEYHOST (FILENAMEFIELD GFILE 'HOST)) + THEN (PACKFILENAME 'HOST MYMEDLEYHOST 'VERSION NIL 'BODY GFILE) + ELSE (PACKFILENAME 'VERSION NIL 'BODY (CONCAT MEDLEYDIR (SUBSTRING + GFILE + (ADD1 (NCHARS GITMEDLEYDIR]) + +(GIT-REPO-FILENAME + [LAMBDA (GFILE) (* ; "Edited 18-Jan-2022 15:42 by rmk") + + (* ;; "Returns the string that the repo expects for a file name. {GIT} or GITMEDLEYDIR is stripped, brackets go to slashes, subdirectories are lower cased, and a final period is remove.") + + (SETQ GFILE (SLASHIT (IF (EQ GITMEDLEYHOST (FILENAMEFIELD GFILE 'HOST)) + THEN (STRIPHOST GFILE) + ELSE (STRIPDIR GFILE GITMEDLEYDIR)) + T)) + (CL:WHEN (EQ (CHARCODE %.) + (NTHCHARCODE GFILE -1)) + (SETQ GFILE (SUBSTRING GFILE 1 -2))) + GFILE]) +) +(DEFINEQ + +(MEDLEYSUBDIRS + [LAMBDA NIL (* ; "Edited 26-Jan-2022 14:52 by rmk") + (* ; "Edited 24-Jan-2022 17:28 by rmk") + (* ; "Edited 18-Jan-2022 15:34 by rmk") + (* ; "Edited 13-Jan-2022 20:16 by rmk") + (FOR F IN (FILDIR (PACKFILENAME 'HOST MYMEDLEYHOST 'BODY '*)) WHEN (DIRECTORYNAMEP F) + UNLESS (THEREIS SKIP IN GIT-IGNORE-DIRECTORIES SUCHTHAT (STRPOS SKIP (FILENAMEFIELD + F + 'DIRECTORY) + 1 NIL T NIL FILEDIRCASEARRAY)) + COLLECT (UNSLASHIT F T]) + +(GITSUBDIRS + [LAMBDA NIL (* ; "Edited 26-Jan-2022 15:12 by rmk") + (* ; "Edited 18-Jan-2022 14:57 by rmk") + (* ; "Edited 13-Jan-2022 16:08 by rmk") + (* ; "Edited 3-Jan-2022 11:12 by rmk") + (* ; "Edited 30-Oct-2021 23:28 by rmk:") + + (* ;; "We drive this with MEDLEYSUBDIRS instead of {GIT}* because GIT has lots of things that we don't want to see (.git directories, cltl2, rooms, etc...)") + + (FOR D IN MEDLEYSUBDIRS COLLECT (IF (EQ MYMEDLEYHOST (FILENAMEFIELD D 'HOST)) + THEN (SLASHIT (PACKFILENAME 'HOST GITMEDLEYHOST 'BODY D) + T) + ELSE (SLASHIT (CONCAT GITMEDLEYDIR + (L-CASE (SUBSTRING D (ADD1 (NCHARS + MEDLEYDIR + ]) +) + +(RPAQ MEDLEYSUBDIRS (MEDLEYSUBDIRS)) + +(RPAQ GITSUBDIRS (GITSUBDIRS)) + + + +(* ;; "") + + + + +(* ;; "Git commands") + +(DEFINEQ + +(GIT-COMMIT + [LAMBDA (FILES TITLE MESSAGE) (* ; "Edited 16-Nov-2021 08:06 by rmk:") + (* ; "Edited 2-Nov-2021 21:26 by rmk:") + + (* ;; "Commits files that are already in the (non-master) current git branch.") + + (CL:WHEN (STREQUAL (GIT-WHICH-BRANCH) + "master") + (ERROR "Cannot commit to the master branch")) + (LET (GFILES) + (SETQ GFILES (FOR F GF INSIDE FILES COLLECT (SETQ GF (INFILEP (GFILE4MFILE F]) + +(GIT-PUSH + [LAMBDA (BRANCH) (* ; "Edited 8-Dec-2021 22:32 by rmk") + (* ; "Edited 16-Nov-2021 08:06 by rmk:") + (* ; "Edited 2-Nov-2021 21:34 by rmk:") + (CL:UNLESS BRANCH + (SETQ BRANCH (GIT-WHICH-BRANCH))) + (CL:WHEN (STREQUAL "master" (GIT-WHICH-BRANCH)) + (ERROR "Cannot push the master branch")) + (GIT-COMMAND (CONCAT "git push " BRANCH]) + +(GIT-PULL + [LAMBDA (BRANCH) (* ; "Edited 8-Dec-2021 22:47 by rmk") + (* ; "Edited 16-Nov-2021 08:06 by rmk:") + (* ; "Edited 2-Nov-2021 21:34 by rmk:") + (GIT-COMMAND (CONCAT "git pull " (OR BRANCH (GIT-WHICH-BRANCH]) + +(GIT-BRANCH-DIFF + [LAMBDA (BRANCH1 BRANCH2) (* ; "Edited 24-Nov-2021 16:30 by rmk:") + (* ; "Edited 22-Nov-2021 09:07 by rmk:") + (* ; "Edited 16-Nov-2021 08:41 by rmk:") + (CL:UNLESS BRANCH1 (SETQ BRANCH1 "origin/master")) + (CL:UNLESS BRANCH2 (SETQ BRANCH2 "origin/master")) + (GIT-REMOTE-UPDATE) + (LET ([MERGE (CAR (GIT-COMMAND (CONCAT "git merge-base " BRANCH1 " " BRANCH2] + FILES POS) + (CL:WHEN (STRPOS "fatal" MERGE) + (ERROR (CONCAT "merge-base failed for " (LIST BRANCH1 BRANCH2)))) + (SETQ FILES (GIT-COMMAND (CONCAT "git diff --name-only " MERGE " " BRANCH1))) + (CL:WHEN (SETQ POS (STRPOS "fatal: ambiguous argument '" (CAR FILES) + 1 NIL T T)) + (ERROR "Unknown branch " (IF (STRPOS BRANCH1 (CAR FILES) + POS NIL T) + THEN BRANCH1 + ELSE BRANCH2))) + FILES]) + +(GIT-APPROVAL + [LAMBDA (BRANCH) (* ; "Edited 19-Nov-2021 15:08 by rmk:") + (GIT-ADD-WORKTREE BRANCH T) + (GIT-ADD-WORKTREE "master" T]) + +(GIT-GET-FILE + [LAMBDA (BRANCH GITFILE MEDLEYFILE) (* ; "Edited 3-Jan-2022 23:52 by rmk") + (* ; "Edited 20-Nov-2021 20:28 by rmk:") + + (* ;; "If GITFILE in BRANCH exists, it is copied to MEDLEYFILE and MEDLEYFILE is returned. If it doesn't exist, return value is NIL. Maybe it should cause a FILENOTFOUND error?") + + (CL:WHEN (GIT-FILE-EXISTS? BRANCH GITFILE) + (CL:WITH-OPEN-FILE (STREAM (OR MEDLEYFILE '{NODIRCORE) + :IF-EXISTS :NEW-VERSION :DIRECTION :IO) + (CL:WITH-OPEN-STREAM (s (CREATE-PROCESS-STREAM (CONCAT (CDGITDIR) + "git show " BRANCH ":" GITFILE)) + ) + (SETFILEINFO s 'ENDOFSTREAMOP (FUNCTION NILL)) + (BIND C WHILE (SETQ C (\BIN s)) DO (\BOUT STREAM C))) + (SETFILEINFO STREAM 'CREATIONDATE (GIT-FILE-DATE GITFILE BRANCH)) + STREAM))]) + +(GIT-FILE-EXISTS? + [LAMBDA (BRANCH GITFILE) (* ; "Edited 10-Dec-2021 21:30 by rmk") + + (* ;; "T if GITFILE exists on BRANCH") + + (CL:WITH-OPEN-FILE (STREAM '{NODIRCORE :DIRECTION :IO) + (CL:WITH-OPEN-STREAM (s (CREATE-PROCESS-STREAM (CONCAT (CDGITDIR) + "git show " BRANCH ":" GITFILE))) + (SETFILEINFO s 'ENDOFSTREAMOP (FUNCTION NILL)) + (LET ((LINE (CL:READ-LINE s))) + (NOT (OR (STREQUAL LINE (CONCAT "fatal: path '" GITFILE + "' does not exist in '" BRANCH "'")) + (STREQUAL LINE (CONCAT "fatal: path '" GITFILE + "' exists on disk, but not in '" BRANCH "'"]) + +(GIT-REMOTE-UPDATE + [LAMBDA (DOIT) (* ; "Edited 16-Dec-2021 10:45 by rmk") + (* ; "Edited 4-Dec-2021 21:49 by rmk") + (* ; "Edited 2-Dec-2021 08:44 by rmk:") + (* ; "Edited 24-Nov-2021 16:34 by rmk:") + (DECLARE (USEDFREE LAST-REMOTE-UPDATE-IDATE)) + + (* ;; "Because git hangs on this (and other things), do this no more than once a day") + + (CL:WHEN [OR DOIT (NOT (BOUNDP 'LAST-REMOTE-UPDATE-IDATE)) + (IGREATERP (IDIFFERENCE (IDATE) + LAST-REMOTE-UPDATE-IDATE) + (CONSTANT (TIMES 24 60 60 1000] + (PRINTOUT T "Updating from remote, local branch is " (GIT-WHICH-BRANCH) + T) + (PROG1 (GIT-COMMAND "git remote update origin") + (SETQ LAST-REMOTE-UPDATE-IDATE (IDATE))))]) + +(GIT-FILE-DATE + [LAMBDA (GFILE BRANCH) (* ; "Edited 3-Jan-2022 19:43 by rmk") + (LET [(DATE (CAR (GIT-COMMAND (CONCAT "git log -1 --pretty=%"format:%%cD%" " + (CL:IF BRANCH + (CONCAT BRANCH " -- ") + "") + (GIT-REPO-FILENAME GFILE T)) + NIL T] + DATE]) +) + + + +(* ;; "") + + + + +(* ;; "Branches") + +(DEFINEQ + +(GIT-CHECKOUT + [LAMBDA (BRANCH) (* ; "Edited 2-Nov-2021 22:40 by rmk:") + (CAR (GIT-COMMAND (CONCAT "git checkout " (OR BRANCH "master") + "; git pull"]) + +(GIT-WHICH-BRANCH + [LAMBDA NIL (* ; "Edited 14-Dec-2021 23:39 by rmk") + (* ; "Edited 12-Dec-2021 11:56 by rmk") + (* ; "Edited 6-Nov-2021 12:11 by rmk:") + (* ; "Edited 3-Oct-2021 15:32 by rmk:") + + (* ;; "Returns the current (local) branch") + + (MKATOM (CONCAT "local/" (CAR (GIT-COMMAND "git rev-parse --abbrev-ref HEAD"]) + +(GIT-MAKE-BRANCH + [LAMBDA (NAME TITLESTRING) (* ; "Edited 26-Jan-2022 12:12 by rmk") + (* ; "Edited 19-Jan-2022 23:25 by rmk") + (* ; "Edited 8-Jan-2022 09:48 by rmk") + (* ; "Edited 2-Nov-2021 21:28 by rmk:") + + (* ;; " The new branch is directly under the currently checked out branch. Maybe it should always make it under master?") + + (* ;; + "This makes a new branch with name NAME: TITLESTRING, or just NAME if TITLESTRING is not given.") + + (* ;; "(GIT-MAKE-BRANCH) makes and checks out the next initialsn branch.") + + (CL:UNLESS NAME + (SETQ NAME (GIT-MY-NEXT-BRANCH))) + (CL:WHEN TITLESTRING + (SETQ NAME (CONCAT NAME (CONCAT ": " TITLESTRING)))) + (LET [(UNDER (GIT-WHICH-BRANCH)) + (RESULT (GIT-COMMAND (CONCAT "git checkout -b " NAME] + (IF (STREQUAL (CAR RESULT) + (CONCAT "Switched to a new branch '" NAME "'")) + THEN (CONCAT (CAR RESULT) + " under " UNDER) + ELSEIF (STREQUAL (CAR RESULT) + (CONCAT "fatal: A branch named '" NAME "' already exists.")) + THEN (ERROR NAME "already exists") + ELSE (HELP "Unexpected git result" RESULT]) + +(GIT-BRANCHES + [LAMBDA (WHERE) (* ; "Edited 8-Dec-2021 08:43 by rmk") + (* ; "Edited 17-Nov-2021 18:20 by rmk:") + (* ; "Edited 16-Nov-2021 09:21 by rmk:") + + (* ;; + "Strips of the %"* %" that indicates the current branch and the 2-space padding on other branches") + + (LET [(LOCAL (CL:WHEN (MEMB WHERE '(NIL ALL LOCAL)) + (GIT-COMMAND "git branch"))) + (REMOTE (CL:WHEN (MEMB WHERE '(NIL ALL REMOTE T)) + (GIT-COMMAND "git branch -r"] + (FOR B IN (APPEND LOCAL REMOTE) COLLECT (SUBATOM B 3]) + +(GIT-BRANCH-EXISTS? + [LAMBDA (BRANCH WHERE NOERROR) (* ; "Edited 16-Dec-2021 08:50 by rmk") + (* ; "Edited 8-Dec-2021 08:44 by rmk") + (* ; "Edited 19-Nov-2021 15:13 by rmk:") + (* ; "Edited 17-Nov-2021 18:24 by rmk:") + + (* ;; "Returns the canonical name of the branch (xxx or origin/xxx) depending on whether BRANCH is local/xxx or origin/xxx") + (* ; "Edited 16-Nov-2021 09:25 by rmk:") + (IF (STRPOS "origin/" BRANCH) + THEN (SETQ WHERE 'REMOTE) + ELSEIF (STRPOS "local/" BRANCH 1 NIL T) + THEN (SETQ WHERE 'LOCAL) + (SETQ BRANCH (SUBATOM BRANCH 7))) + (IF (CAR (MEMB (MKATOM BRANCH) + (GIT-BRANCHES WHERE))) + ELSEIF (NOT NOERROR) + THEN (ERROR "Unknown branch" BRANCH]) +) + + + +(* ;; "My branches") + +(DEFINEQ + +(GIT-MY-CURRENT-BRANCH + [LAMBDA NIL (* ; "Edited 19-Jan-2022 13:22 by rmk") + (CAR (LAST (GIT-MY-BRANCHES]) + +(GIT-MY-BRANCHP + [LAMBDA (BRANCH) (* ; "Edited 26-Jan-2022 11:41 by rmk") + (* ; "Edited 19-Jan-2022 13:22 by rmk") + + (* ;; "Returns n if BRANCH is INITIALSn (local or origin), possibly followed by a trailing comment after colon or space.") + + (CL:UNLESS BRANCH + (SETQ BRANCH (GIT-WHICH-BRANCH))) + (LET* ((INITS (GIT-INITIALS)) + (INC (NCHARS INITS)) + (SPOS (ADD1 (OR (STRPOS "/" BRANCH) + 0))) + (EPOS)) + (CL:WHEN (STRPOS INITS BRANCH SPOS NIL T NIL UPPERCASEARRAY) + (CL:WHEN (SETQ EPOS (\UPF.NEXTPOS (CHARCODE (%: SPACE)) + BRANCH SPOS)) + (ADD EPOS -1)) + (SUBATOM BRANCH (IPLUS SPOS INC) + EPOS))]) + +(GIT-MY-NEXT-BRANCH + [LAMBDA NIL (* ; "Edited 19-Jan-2022 23:14 by rmk") + (* ; "Edited 8-Jan-2022 09:43 by rmk") + + (* ;; "Figures out what my next incremental branch would be. ") + + (PACK* (GIT-INITIALS) + (ADD1 (OR (GIT-MY-BRANCHP (GIT-MY-CURRENT-BRANCH)) + 0]) + +(GIT-MY-BRANCHES + [LAMBDA NIL (* ; "Edited 19-Jan-2022 13:20 by rmk") + (* ; "Edited 8-Jan-2022 09:53 by rmk") + (* ; "Edited 12-Dec-2021 11:46 by rmk") + + (* ;; "This returns only local branch names: xyzn and not origin/xyzn or local/xyzn") + + (* ;; "If INITIALS is xyz or xyz:, returns xyzn where xyzn is a branch and n is greater than m for all other branches xyzm. xyzn may not be be the current branch.") + + (* ;; "The return list is sorted so that lower n's come before later n's. The last element is my current branch") + + (FOR B (INITS _ (GIT-INITIALS)) + INC IN (GIT-BRANCHES) FIRST (SETQ INC (NCHARS INITS)) + WHEN (STRPOS INITS B 1 NIL T NIL UPPERCASEARRAY) COLLECT B + FINALLY (RETURN (SORT $$VAL (FUNCTION (LAMBDA (A B) + (ILESSP (SUBATOM A (ADD1 INC)) + (SUBATOM B (ADD1 INC]) +) + + + +(* ;; "") + + + + +(* ;; "Worktrees") + +(DEFINEQ + +(GIT-ADD-WORKTREE + [LAMBDA (BRANCH REMOTEONLY) (* ; "Edited 12-Dec-2021 11:57 by rmk") + (* ; "Edited 25-Nov-2021 08:45 by rmk:") + (* ; "Edited 19-Nov-2021 19:01 by rmk:") + (* ; "Edited 17-Nov-2021 18:25 by rmk:") + (SETQ BRANCH (GITORIGIN BRANCH (NOT REMOTEONLY))) + (CL:UNLESS (OR (GIT-BRANCH-EXISTS? BRANCH NIL T) + (GIT-BRANCH-EXISTS? BRANCH T)) + (ERROR BRANCH "is not a git branch")) + (CL:WHEN (STRING-EQUAL BRANCH (GIT-WHICH-BRANCH)) + (ERROR BRANCH "is the current branch")) + (LET (LINES LOCALBRANCH) + [SETQ LINES (GIT-COMMAND (IF (EQ 1 (STRPOS "origin/" BRANCH)) + THEN [SETQ LOCALBRANCH (SUBSTRING BRANCH + (CONSTANT (ADD1 (NCHARS "origin/" + ] + (CONCAT "git worktree add --guess-remote " (WORKTREEDIR + LOCALBRANCH) + " " BRANCH) + ELSE (CONCAT "git worktree add " (WORKTREEDIR BRANCH) + " " BRANCH] + (CL:UNLESS (STRPOS "Preparing worktree" (CAR LINES) + 1 NIL T) + (ERROR "Could not create worktree for " BRANCH)) + BRANCH]) + +(GIT-REMOVE-WORKTREE + [LAMBDA (BRANCH) (* ; "Edited 17-Nov-2021 10:02 by rmk:") + (GIT-BRANCH-EXISTS? BRANCH) + (LET ((DIR (WORKTREEDIR BRANCH)) + LINES) + (SETQ LINES (GIT-COMMAND (CONCAT "git worktree remove " DIR))) + (CL:WHEN (STRPOS "fatal: " (CAR LINES) + 1 NIL T) + (ERROR "Could not remove worktree for " BRANCH)) + (AND NIL (DELFILE (CONCAT PATH "/.DS_Store")) + (GIT-COMMAND (CONCAT "rmdir " DIR))) + BRANCH]) + +(GIT-LIST-WORKTREES + [LAMBDA NIL (* ; "Edited 12-Dec-2021 12:13 by rmk") + (* ; "Edited 19-Nov-2021 18:53 by rmk:") + + (* ;; "The git command tells us what the clone thinks about it, but then we look to see what is actually in our worktrees directory, to make sure that the subdirectory wasn't deleted in a wy that the clone didn't know about.") + + (SORT (FOR L POS IN (GIT-COMMAND "git worktree list") + WHEN (AND (SETQ POS (STRPOS "/worktrees/" L NIL NIL NIL T)) + (STRPOS "(detached HEAD)" L)) COLLECT (SETQ L (SUBSTRING L POS)) + (SUBATOM L 1 (SUB1 (STRPOS " " L]) + +(WORKTREEDIR + [LAMBDA (BRANCH) (* ; "Edited 18-Jan-2022 15:02 by rmk") + (* ; "Edited 25-Nov-2021 08:49 by rmk:") + (* ; "Edited 19-Nov-2021 20:56 by rmk:") + (* ; "Edited 17-Nov-2021 10:00 by rmk:") + (CONCAT GITMEDLEYDIR "../worktrees/" (IF BRANCH + THEN "/" + ELSE ""]) +) + + + +(* ;; "") + + + + +(* ;; "Comparisons") + +(DEFINEQ + +(GIT-GET-DIFFERENT-FILES + [LAMBDA (BRANCH1 BRANCH2 DIR1 DIR2) (* ; "Edited 23-Jan-2022 21:45 by rmk") + (* ; "Edited 11-Jan-2022 11:03 by rmk") + (* ; "Edited 5-Jan-2022 08:01 by rmk") + + (* ;; "Ask git for the files that differ between the branches, copy those files down to local DIR1 and DIR2, return the directories.") + + (SETQ BRANCH1 (GIT-BRANCH-EXISTS? BRANCH1)) + (SETQ BRANCH2 (GIT-BRANCH-EXISTS? BRANCH2)) + (LET ([MERGE (CAR (GIT-COMMAND (CONCAT "git merge-base " BRANCH1 " " BRANCH2] + (DATE (DATE)) + DIFFS) + (SETQ DIFFS (GIT-BRANCH-DIFF BRANCH1 MERGE)) + (CL:WHEN DIFFS + (PSEUDOHOST 'FROMGIT (CONCAT "{core}" DATE ">")) + (CL:UNLESS DIR1 + (SETQ DIR1 (CONCAT "{FROMGIT}<" (UNSLASHIT BRANCH1) + ">"))) + (CL:UNLESS DIR2 + (SETQ DIR2 (CONCAT "{FROMGIT}<" (UNSLASHIT BRANCH2) + ">"))) + [FOR GFILE MFILE IN DIFFS DO + (* ;; "Unslash because CORE doesn't know about /. ") + + (SETQ MFILE (UNSLASHIT (CONCAT DIR1 GFILE))) + (CL:WHEN (GIT-GET-FILE BRANCH1 GFILE MFILE) + (FIX-DIRECTORY-DATES (CONS MFILE))) + (SETQ MFILE (UNSLASHIT (CONCAT DIR2 GFILE))) + (CL:WHEN (GIT-GET-FILE MERGE GFILE MFILE) + (FIX-DIRECTORY-DATES (CONS MFILE)))] + (LIST DIR1 DIR2))]) + +(GIT-COMPARE-BRANCHES + [LAMBDA (BRANCH1 BRANCH2 LOCAL) (* ; "Edited 26-Jan-2022 13:42 by rmk") + (* ; "Edited 11-Jan-2022 11:10 by rmk") + (* ; "Edited 6-Jan-2022 13:05 by rmk") + (* ; "Edited 4-Jan-2022 22:52 by rmk") + (* ; "Edited 22-Dec-2021 16:14 by rmk") + (* ; "Edited 16-Dec-2021 11:18 by rmk") + (SETQ BRANCH1 (IF BRANCH1 + THEN (GITORIGIN BRANCH1 LOCAL) + ELSE (GIT-WHICH-BRANCH))) + (SETQ BRANCH2 (GITORIGIN (OR BRANCH2 "master") + LOCAL)) + (PRINTOUT T "Comparing all subdirectories of " BRANCH1 " and " BRANCH2 T) + (LET (CDVALUE DIRS) + (PRINTOUT T "Fetching differences" T) + (SETQ DIRS (GIT-GET-DIFFERENT-FILES BRANCH1 BRANCH2)) + (IF DIRS + THEN (TERPRI T) + (SETQ CDVALUE (COMPAREDIRECTORIES (CAR DIRS) + (CADR DIRS) + '(> < ~= -* *-) + '*>*.*)) + (TERPRI T) + (IF (FETCH (CDVALUE CDENTRIES) OF CDVALUE) + THEN + (* ;; + "Lower case the directories. Perhaps can be done when the files are gotten?") + + [FOR CDE INFO IN (FETCH (CDVALUE CDENTRIES) OF CDVALUE) + DO (CL:WHEN (SETQ INFO (FETCH INFO1 OF CDE)) + (CHANGE (FETCH (CDINFO FULLNAME) OF INFO) + (SLASHIT DATUM T))) + (CL:WHEN (SETQ INFO (FETCH INFO2 OF CDE)) + (CHANGE (FETCH (CDINFO FULLNAME) OF INFO) + (SLASHIT DATUM T)))] + (CDBROWSER CDVALUE (CONCAT "Compare " BRANCH1 " and " BRANCH2 " " + (LENGTH (FETCH (CDVALUE CDENTRIES) OF CDVALUE)) + " files") + (LIST BRANCH1 BRANCH2) + `(LABELFN GIT-CD-LABELFN BRANCH1 ,BRANCH1 BRANCH2 ,BRANCH2) + NIL + `(Compare "" (,(CONCAT "See " BRANCH1) + CD-MENUFN See% left) + (,(CONCAT "See " BRANCH2) + CD-MENUFN See% right) + See% both)) + ELSE "NO DIFFERENCES") + ELSE "NO DIFFERENCES"]) + +(GIT-COMPARE-WITH-MYMEDLEY + [LAMBDA (SUBDIRS SELECT EXCLUDEDFILES TEDIT FIXDIRECTORYDATES UPDATE) + + (* ;; + "Edited 26-Jan-2022 22:53 by rmk: my medley subdirectories with the current local git branch.") + + (* ;; "Compares my medley subdirectories with the current local git branch.") + + (CL:WHEN UPDATE (GIT-REMOTE-UPDATE)) (* ; "Doesn't matter if we are looking only at local files in the current branch. We aren't fetching or checking out.") + (CL:WHEN (AND (LISTP SUBDIRS) + (NULL (CDR SUBDIRS))) + (SETQ SUBDIRS (CAR SUBDIRS))) + (SETQ SUBDIRS (L-CASE SUBDIRS)) + (PRINTOUT T "Comparing " (SELECTQ SUBDIRS + (nil (SETQ SUBDIRS '(sources library lispusers))) + (all (SETQ SUBDIRS MEDLEYSUBDIRS) + "ALL subdirectories") + SUBDIRS) + " of My Medley and " + (GIT-WHICH-BRANCH) + T) + (for SUBDIR TITLE CDVAL (BRANCH2 _ (GIT-WHICH-BRANCH)) INSIDE SUBDIRS + collect (TERPRI T) + (SETQ CDVAL (COMPAREDIRECTORIES (MEDLEYSUBDIR SUBDIR T) + (GITSUBDIR SUBDIR T) + (OR SELECT '(> < ~= -* *-)) + NIL GIT-IGNORE-FILES NIL NIL NIL FIXDIRECTORYDATES)) + [FOR CDE IN (FETCH CDENTRIES OF CDVAL) + DO (CL:WHEN (FETCH INFO1 OF CDE) + (CHANGE (FETCH (CDINFO FULLNAME) OF (FETCH INFO1 OF CDE)) + (UNSLASHIT DATUM T))) + (CL:WHEN (FETCH INFO2 OF CDE) + (CHANGE (FETCH (CDINFO FULLNAME) OF (FETCH INFO2 OF CDE)) + (SLASHIT DATUM T)))] + CDVAL + finally + + (* ;; "Set up the browsers after everything has been done, otherwise if the user doesn't pay attention it might hang waiting for a region.") + + (CL:WHEN (AND (CDR $$VAL) + GIT-MERGE-COMPARES) + (SETQ $$VAL (CDMERGE $$VAL)) + [SETQ SUBDIRS (CONCATLIST (FOR SUBDIR IN SUBDIRS COLLECT (CONCAT SUBDIR " "]) + (RETURN + (for CDVAL TITLE IN $$VAL as SUBDIR inside SUBDIRS + collect (SETQ TITLE (CONCAT "Compare My Medley and " BRANCH2 " " SUBDIR + " " (LENGTH (fetch (CDVALUE CDENTRIES) of CDVAL)) + " files")) + [if TEDIT + then [CDTEDIT CDVAL TITLE `("My Medley" ,BRANCH2] + else (CDBROWSER CDVAL TITLE `("My Medley" ,BRANCH2) + `(BRANCH1 "My Medley" BRANCH2 ,BRANCH2 SUBDIR ,SUBDIR LABELFN + GIT-CD-LABELFN) + NIL + `(Compare "" ("See My Medley" CD-MENUFN See% left) + (,(CONCAT "See " BRANCH2) + CD-MENUFN See% right) + See% both "" (Copy% <- GIT-CD-MENUFN) + (|Delete ALL <-| GIT-CD-MENUFN) + ,@(CL:UNLESS (STRPOS "master" BRANCH2) + '("" (Copy% -> GIT-CD-MENUFN) + (Delete% -> GIT-CD-MENUFN)))] + (CONS (CONCAT SUBDIR "/") + (for CDENTRY in (fetch CDENTRIES of CDVAL) collect (fetch MATCHNAME + of CDENTRY))) + finally (TERPRI T]) + +(GIT-COMPARE-WORKTREE + [LAMBDA (BRANCH DONTUPDATE) (* ; "Edited 25-Nov-2021 08:49 by rmk:") + (* ; "Edited 19-Nov-2021 21:54 by rmk:") + (PRINTOUT T T "Comparing origin/" BRANCH " and origin/master" T) + (CL:UNLESS DONTUPDATE + (GIT-ADD-WORKTREE BRANCH T) + (GIT-ADD-WORKTREE "master" T)) + (LET (ADDEDFILES DELETEDFILES SOURCEFILES COMPILEDFILES OTHERFILES) + (FOR FILE BFILE MFILE IN (GIT-BRANCH-DIFF BRANCH 'origin/master) + DO (SETQ BFILE (INFILEP (CONCAT (WORKTREEDIR BRANCH) + FILE))) + (SETQ MFILE (INFILEP (CONCAT (WORKTREEDIR 'master) + FILE))) + (IF (AND BFILE MFILE) + THEN (IF (NOT (LISPSOURCEFILEP BFILE)) + THEN (PUSH OTHERFILES FILE) + ELSEIF (MEMB (U-CASE (FILENAMEFIELD BFILE 'EXTENSION)) + *COMPILED-EXTENSIONS*) + THEN (PUSH COMPILEDFILES FILE) + ELSE (PUSH SOURCEFILES FILE)) + ELSEIF BFILE + THEN (PUSH ADDEDFILES FILE) + ELSE (PUSH DELETEDFILES FILE))) + (CL:WHEN ADDEDFILES + (PRINTOUT T T "Added files: " T) + (FOR F IN (SORT ADDEDFILES) DO (PRINTOUT T 2 F T))) + (CL:WHEN DELETEDFILES + (PRINTOUT T T "Deleted files: " T) + (FOR F IN (SORT ADDEDFILES) DO (PRINTOUT T 2 F T))) + (CL:WHEN SOURCEFILES + (PRINTOUT T T "Changed Medley source files:" T) + (FOR FILETAIL FILE BFILE MFILE ON (SORT SOURCEFILES) + DO (SETQ FILE (CAR FILETAIL)) + (PRINTOUT T 2 FILE T) + (SETQ FILE (CAR FILETAIL)) + (SETQ BFILE (INFILEP (CONCAT (WORKTREEDIR BRANCH) + FILE))) + (SETQ MFILE (INFILEP (CONCAT (WORKTREEDIR 'master) + FILE))) + (COMPARESOURCES-TEDIT BFILE MFILE) + (TTY.PROCESS T) + (CL:WHEN (OR OTHERFILES (CDR FILETAIL)) + (WAITFORINPUT)))) + (CL:WHEN COMPILEDFILES + (PRINTOUT T T "Medley compiled files, no comparisons:") + (FOR F IN COMPILEDFILES DO (PRINTOUT T 2 F T))) + (CL:WHEN OTHERFILES + (PRINTOUT T T "Other changed files, using TEDIT-SEE") + (FOR FILETAIL FILE BFILE MFILE ON (SORT OTHERFILES) + DO (SETQ FILE (CAR FILETAIL)) + (PRINTOUT T 2 FILE) + (SETQ FILE (CAR FILETAIL)) + (SETQ BFILE (INFILEP (CONCAT (WORKTREEDIR BRANCH) + FILE))) + (SETQ MFILE (INFILEP (CONCAT (WORKTREEDIR 'master) + FILE))) + (COMPARETEXT BFILE MFILE 'LINE) + (AND NIL (TEDIT-SEE BFILE) + (TEDIT-SEE MFILE)) + (TTY.PROCESS T) + (CL:WHEN (CDR FILETAIL) + (WAITFORINPUT))))]) + +(GITCDOBJBUTTONFN + [LAMBDA (OBJ WINDOW) (* ; "Edited 20-Dec-2021 09:57 by rmk") + (* ; "Edited 15-Dec-2021 20:47 by rmk") + (* ; "Edited 27-Nov-2021 12:19 by rmk:") + (* ; "Edited 26-Nov-2021 08:51 by rmk:") + (* ; "Edited 23-Nov-2021 12:39 by rmk:") + (* ; "Edited 8-Nov-2021 08:46 by rmk:") + (LET + ([CDENTRY (CAR (IMAGEOBJPROP OBJ 'OBJECTDATUM] + (BRANCH1 (WINDOWPROP WINDOW 'BRANCH1)) + (FONT (FONTCREATE 'TERMINAL 10)) + COPYITEM COMPAREITEMS TYPE INFO1 INFO2) + (CL:WHEN (AND CDENTRY (CADR (IMAGEOBJPROP OBJ 'OBJECTDATUM)) + (EQ LASTKEYBOARD 0)) + (SETQ INFO1 (FETCH (CDENTRY INFO1) OF CDENTRY)) + (SETQ INFO2 (FETCH (CDENTRY INFO2) OF CDENTRY)) + [IF (MOUSESTATE (ONLY LEFT)) + THEN + [SETQ COMPAREITEMS + (IF (AND INFO1 INFO2) + THEN [IF (EQ (SETQ TYPE (FETCH (CDINFO TYPE) OF INFO1)) + (FETCH (CDINFO TYPE) OF INFO2)) + THEN (SELECTQ TYPE + (SOURCE [LIST (LIST "Compare sources?" ''COMPARESOURCES) + (LIST "Examine sources?" ''EXAMINE]) + (COMPILED) + (TEXT (LIST (CONCAT "Compare text files?") + ''TEXT)) + (IF (MEMB (U-CASE (FILENAMEFIELD (FETCH (CDINFO FULLNAME) + OF INFO1))) + '(TEXT TXT)) + THEN [LIST (LIST "Compare text files?" (KWOTE TYPE) + ''COMPARETEXT] + ELSE (LIST (LIST (CONCAT "See " TYPE " files?") + (KWOTE TYPE] + ELSEIF (OR INFO1 INFO2) + THEN (LIST (LIST "Show file?" ''TEDIT] + ELSEIF [AND (MOUSESTATE (ONLY MIDDLE)) + (NOT (WINDOWPROP WINDOW 'READONLY] + THEN (SETQ COPYITEM (CONS (SELECTQ (CADDR (IMAGEOBJPROP OBJ 'OBJECTDATUM)) + (LEFT (LIST (CONCAT "Copy TO git " (GIT-WHICH-BRANCH) + "?") + ''TOGIT)) + (RIGHT (LIST (CONCAT "Copy FROM git " (GIT-WHICH-BRANCH) + "?") + ''FROMGIT)) + NIL] + (CL:WHEN (OR COPYITEM COMPAREITEMS) + (SELECTQ (MENU (CREATE MENU + TITLE _ (CONCAT (WINDOWPROP WINDOW 'SUBDIR) + "/" + (FETCH MATCHNAME OF CDENTRY)) + ITEMS _ (APPEND COPYITEM COMPAREITEMS) + MENUFONT _ FONT + MENUTITLEFONT _ FONT)) + (TOGIT (CL:WHEN (TOGIT (FETCH (CDINFO FULLNAME) OF INFO1) + WINDOW) + (IMAGEOBJPROP OBJ 'COPIED T) + (REDISPLAYW WINDOW) + (CDOBJ.DISPLAYFN OBJ WINDOW))) + (FROMGIT (CL:WHEN (FROMGIT (FETCH (CDINFO FULLNAME) OF INFO2) + WINDOW) + (IMAGEOBJPROP OBJ 'COPIED T) + (AND NIL (REDISPLAYW WINDOW)))) + (COMPARESOURCES + (TTY.PROCESS T) + (CSBROWSER (fetch (CDINFO FULLNAME) OF INFO1) + (fetch (CDINFO FULLNAME) OF INFO2))) + (COMPARETEXT (TTY.PROCESS T) + (COMPARETEXT (FETCH (CDINFO FULLNAME) OF INFO1) + (FETCH (CDINFO FULLNAME) OF INFO2) + 'PARA)) + (TEDIT (CL:WHEN INFO1 + (TEDIT-SEE (FETCH (CDINFO FULLNAME) OF INFO1))) + (CL:WHEN INFO2 + (TEDIT-SEE (FETCH (CDINFO FULLNAME) OF INFO2)))) + NIL)))]) + +(GIT-CD-LABELFN + [LAMBDA (FILE1 FILE2 USERDATA) (* ; "Edited 5-Jan-2022 15:10 by rmk") + (* ; "Edited 16-Dec-2021 12:25 by rmk") + (* ; "Edited 13-Dec-2021 22:13 by rmk") + (DECLARE (USEDFREE CDVALUE)) + (LET (NC B LABEL1 LABEL2) + (CL:WHEN (SETQ NC (FETCH NCDIR OF (FETCH CDMAXNC1 OF CDVALUE))) + (SETQ LABEL1 (SLASHIT (SUBSTRING FILE1 (ADD1 NC)) + T)) + (CL:WHEN (SETQ B (LISTGET USERDATA 'BRANCH1)) + (SETQ LABEL1 (CONCAT B "/" LABEL1)))) + (CL:WHEN (SETQ NC (FETCH NCDIR OF (FETCH CDMAXNC2 OF CDVALUE))) + (SETQ LABEL2 (SLASHIT (SUBSTRING FILE2 (ADD1 NC)) + T)) + (CL:WHEN (SETQ B (LISTGET USERDATA 'BRANCH2)) + (SETQ LABEL2 (CONCAT B "/" LABEL2)))) + (LIST (OR LABEL1 FILE1) + (OR LABEL2 FILE2]) + +(GIT-CD-MENUFN + [LAMBDA (TBITEM MENUITEM CDBROWSER KEY) (* ; "Edited 19-Dec-2021 23:28 by rmk") + (* ; "Edited 16-Dec-2021 13:49 by rmk") + (* ; "Edited 10-Dec-2021 08:52 by rmk") + + (* ;; "MENUITEM is of the form (display-atom . extrainfo). The selector for the selectq is either the CAR of the extrainfo or the display atom") + + (DECLARE (USEDFREE FILE1 FILE2 LABEL2 TYPE CDENTRY)) + (SELECTQ (OR (CADDR MENUITEM) + (CAR MENUITEM)) + (Copy% -> (CL:WHEN (CAR (TOGIT FILE1)) + (TB.DELETE.ITEM CDBROWSER TBITEM))) + (Copy% <- (CL:WHEN (CAR (FROMGIT FILE2)) + (TB.DELETE.ITEM CDBROWSER TBITEM))) + (Delete% -> (FLASHWINDOW PWINDOW) + (IF FILE1 + THEN (PRIN3 "Use 'Delete BOTH' instead") + ELSE (GIVE.TTY.PROCESS PWINDOW) + (CL:WHEN (EQ 'Y (ASKUSER NIL 'N (CONCAT "Delete " LABEL2 " ? "))) + (GIT-DELETE-FILE FILE2) + (TB.DELETE.ITEM CDBROWSER TBITEM)))) + (|Delete ALL <-| + (FLASHWINDOW PWINDOW) + (IF FILE2 + THEN (PRIN3 "Use 'Delete BOTH' instead") + ELSE (GIVE.TTY.PROCESS PWINDOW) + (CL:WHEN (EQ 'Y (ASKUSER NIL 'N (CONCAT "Delete ALL versions of " + (NAMEFIELD LABEL1 T) + " ? "))) + (MYMEDLEY-DELETE-FILES FILE1) + (TB.DELETE.ITEM CDBROWSER TBITEM)))) + (Delete% BOTH (FLASHWINDOW PWINDOW) + (GIVE.TTY.PROCESS PWINDOW) + (CL:WHEN (EQ 'Y (ASKUSER NIL 'N (CONCAT + "Delete all Medley and git versions of " + (NAMEFIELD LABEL1 T) + " ? "))) + (GIT-DELETE-FILE FILE2) + (MYMEDLEY-DELETE-FILES FILE1) + (TB.DELETE.ITEM CDBROWSER TBITEM))) + (SHOULDNT]) +) + + + +(* ;; "") + + + + +(* ;; "Utilities") + +(DEFINEQ + +(CDGITDIR + [LAMBDA NIL (* ; "Edited 18-Jan-2022 15:37 by rmk") + (* ; "Edited 16-Nov-2021 10:16 by rmk:") + (* ; "Edited 2-Nov-2021 21:12 by rmk:") + + (* ;; "Strips off {UNIX}") + + (CONCAT "cd " (STRIPHOST GITMEDLEYDIR) + "; "]) + +(GIT-COMMAND + [LAMBDA (CMD ALL NOERROR) (* ; "Edited 3-Jan-2022 10:47 by rmk") + (* ; "Edited 24-Nov-2021 16:44 by rmk:") + (* ; "Edited 16-Nov-2021 09:07 by rmk:") + (* ; "Edited 2-Nov-2021 21:08 by rmk:") + (* ; "Edited 7-Oct-2021 11:15 by rmk:") + + (* ;; "Suppress .git lines unless ALL") + + (CL:UNLESS (EQ 1 (STRPOS "git" CMD)) + (SETQ CMD (CONCAT "git " CMD))) + [BIND LPOS WHILE (SETQ LPOS (STRPOS "local/" CMD)) + DO (SETQ CMD (CONCAT (SUBSTRING CMD 1 (SUB1 LPOS)) + (SUBSTRING CMD (IPLUS LPOS (NCHARS "local/"] + (CL:WITH-OPEN-FILE (STREAM "{NODIRCORE}shell-dribble.txt" :DIRECTION :IO) + (ShellCommand (CONCAT (CDGITDIR) + CMD) + STREAM) + (SETFILEPTR STREAM 0) + (BIND LINE UNTIL (EOFP STREAM) + WHEN [PROGN (SETQ LINE (CL:READ-LINE STREAM :EOF-ERROR-P NIL :EOF-VALUE NIL)) + (OR ALL (NOT (STRPOS ".git" LINE 1 NIL T] COLLECT LINE + FINALLY (CL:UNLESS NOERROR + (CL:WHEN (STRPOS "fatal" (CAR $$VAL)) + (ERROR (CONCAT "Git command %"" CMD "%" failed") + (CAR $$VAL))))]) + +(GITORIGIN + [LAMBDA (BRANCH LOCAL) (* ; "Edited 25-Nov-2021 08:47 by rmk:") + (* ; "Edited 22-Nov-2021 17:29 by rmk:") + + (* ;; "Insures origin/ unless LOCAL or local/ already") + + (CL:UNLESS BRANCH (SETQ BRANCH "master")) + (IF (OR (STRPOS "origin/" BRANCH) + (STRPOS "local/" BRANCH)) + THEN BRANCH + ELSE (CONCAT (CL:IF LOCAL + "local/" + "origin/") + BRANCH]) + +(GIT-INITIALS + [LAMBDA NIL (* ; "Edited 19-Jan-2022 13:18 by rmk") + (OR (CL:IF (EQ (CHARCODE %:) + (NTHCHARCODE INITIALS -1)) + (SUBSTRING INITIALS 1 -2) + INITIALS) + (ERROR "INITIALS is not set"]) +) +(DECLARE%: DONTCOPY + (FILEMAP (NIL (4688 9814 (TOGIT 4698 . 6617) (FROMGIT 6619 . 7478) (GIT-DELETE-FILE 7480 . 8374) ( +MYMEDLEY-DELETE-FILES 8376 . 9812)) (9815 11456 (MEDLEYSUBDIR 9825 . 10265) (GITSUBDIR 10267 . 10843) +(STRIPDIR 10845 . 11216) (STRIPHOST 11218 . 11454)) (11457 13394 (GFILE4MFILE 11467 . 12138) ( +MFILE4GFILE 12140 . 12693) (GIT-REPO-FILENAME 12695 . 13392)) (13395 15729 (MEDLEYSUBDIRS 13405 . +14373) (GITSUBDIRS 14375 . 15727)) (15856 22350 (GIT-COMMIT 15866 . 16444) (GIT-PUSH 16446 . 17002) ( +GIT-PULL 17004 . 17410) (GIT-BRANCH-DIFF 17412 . 18607) (GIT-APPROVAL 18609 . 18810) (GIT-GET-FILE +18812 . 19916) (GIT-FILE-EXISTS? 19918 . 20797) (GIT-REMOTE-UPDATE 20799 . 21841) (GIT-FILE-DATE 21843 + . 22348)) (22395 26572 (GIT-CHECKOUT 22405 . 22646) (GIT-WHICH-BRANCH 22648 . 23232) (GIT-MAKE-BRANCH + 23234 . 24725) (GIT-BRANCHES 24727 . 25507) (GIT-BRANCH-EXISTS? 25509 . 26570)) (26602 29307 ( +GIT-MY-CURRENT-BRANCH 26612 . 26785) (GIT-MY-BRANCHP 26787 . 27706) (GIT-MY-NEXT-BRANCH 27708 . 28149) + (GIT-MY-BRANCHES 28151 . 29305)) (29353 33123 (GIT-ADD-WORKTREE 29363 . 31123) (GIT-REMOVE-WORKTREE +31125 . 31703) (GIT-LIST-WORKTREES 31705 . 32509) (WORKTREEDIR 32511 . 33121)) (33171 54106 ( +GIT-GET-DIFFERENT-FILES 33181 . 35051) (GIT-COMPARE-BRANCHES 35053 . 38191) (GIT-COMPARE-WITH-MYMEDLEY + 38193 . 42091) (GIT-COMPARE-WORKTREE 42093 . 45570) (GITCDOBJBUTTONFN 45572 . 50576) (GIT-CD-LABELFN +50578 . 51660) (GIT-CD-MENUFN 51662 . 54104)) (54152 57051 (CDGITDIR 54162 . 54594) (GIT-COMMAND 54596 + . 56164) (GITORIGIN 56166 . 56743) (GIT-INITIALS 56745 . 57049))))) +STOP diff --git a/lispusers/GITFNS.LCOM b/lispusers/GITFNS.LCOM new file mode 100644 index 0000000000000000000000000000000000000000..32563473e7af3b5577a80f5da4a61993c7079b29 GIT binary patch literal 27253 zcmbt-du&|SncoaaTQ*~HNl9@WM(Z5UTJli!(3~e9cH|k(3^hZ}%pJ``6m7@ykTcTI z;zK1V%Yx%Jy9wG9?RIy&>%dN%w8%D_qDfnl5`oxqc7PVeq79HOkQT@m3v3HCX#Xmd z{?q=^M*V%?cg}sxP_iA{@bKPq&%NiI@BKQ*!Ay28U&@B&@`Y?DUz)SjljT%;A$2aR z0{K!cTPftL<$!v!l1*i5so6qT^K7b`RpE)T!NDMXA&qXeY(@nliO_swBNUm4L{ua) z6OYcsCju%MSlL{^wz}48s?7}*P=jw}sta$wP~UECZJ)i`xVF~VI9u3UX{?=HZ#CCi zH>2b6v+FlQa&vZVb^F?N?s_g?n=4hvpO41JyhDX2W+LI4Xf&Xfw_5gCgRM8OZEc^L zQFt$uwueWyN81c>@2#HP1OaMxs z8UeAf!I}lIs+r8xV6dzbDwD0&R9VHiNq-)tpH6b5@o?^7AV1vy$GH#NU(fkJ z%=P`K&|Vz+3_U(L%3TYCbn^j}i zD01Vg-{fw^zjxoaN_XZD1{d0+FTKBa@3n=~AMD+G$rlVy##OnJFGW>2F|E>8DV?gR zaC}nD6;jpQV!o8I7F9SF!K3mLfkK6&F@O(OF$S9oMh8b&-fo;_br71Y#}0&C-YWi=I5#NTvNN)@vz5tlEkcm!xDWq5py!NUQ4#4?My zd^#7Jt)xon97uk0Qq5YKB{dmV7qXRV-YThSwcgm?X>H*t78wI;uQWC`Hh0u=ORa2P zTWvK1SmCq^r1?heY@$mzJb~ZUZABe-+AXyPR@>fDZ$KKXZf-mkP;tD$6DnCXHD}dJ z8N8LiR~j47?9hjA(wFE}86I5U*jQPJwcLt&JjrSHR14_1xYZc!cGf#91TQhJ^UW__51wgBr__*?e49U=aX04tL@6s zBgD5qV3;Narb&kPurC-Rfm7hIqtlvb!7QNuvQ-6z@lZtQbNOr`1M*BLnikP%G^zqb zS1A#r1*??h-k=_%7ThbX8W9IpW75$JhJ@2fgg>l&e}8~Tr^XXq_SM`=y8Xt;L?18F z`AIrbi5In7YWhd~{R`ZK*DRO(J^tY*3;Y`23uG4fy0dWXNBM&zIf$U&&Ygb0um9lI zJirtV8{mW|CRK%5pXVQ*hPQ&~JcGP&7}!g1USDgn z^k}x$T01RJHAHPdZklHak*wW?tqrM$K^>_IqfkE}s_jDJDWBgbm?|^4lc{$Y7hmUJ z1~nr9u!XGl0>H?4tQ8WDR}!-)9)WO#5Svngvu7|tTj)G^b{?LBcslbjr)Ss%yip|y z0!97nPWL&QE@_oAVV%`|9=z?K&?5v6;c!KBPBBZDg{8lfOz{M-{+t0ioCGw9dF!*H zy%cB(DklXiAso>>t!0>=3X2$RdQ2!{d71^$9)R?lexJ|pk{Tm^U+%qR&NEufH5!m5 za>K|;pz3YH5iLe*V!du{&p;C3%0*+ONx~jlVtMC5A6lXwk%*~Y^9?{|w99S-Mnv7R z@4Q=r?4M+EtnjaxHOZq7lYHDg<7%rWU!yiRbRC)%3x}k_ghLi#m=GQ^p0>5jbkqeT zNCl0O1Pl?kB>}=BKsk&L?1>ctOUKqgL9o3*jK~N^E%OIdnlUBfx+&%~!8Bq-N2YBy z3IjJRz#Pi}+|Gy+{bwUeZVy*XZl?Dl3X=m`F7_xT4gd2lSRV#|hJLbgIQ$J$LJikT zhApQ+zHVqjkZDU1qS4`qMAU#kI^})g5M38fxIi7(LNyk*K@HK$(2qDx&=U-5TTP0_ zuVl+s$Y9qnzqXzLxQ|l$0Ogl_u;)Gc{hOl1|5oxmlcrGRvah**kMGyU@4lD3y8bI> z2^I}ljsu7o08z`4a7bI3EGcsXNm2hIrm!3qS-hr0Amm!6myNYd!H5g_G8>F@SSL&@ zm##;{6x$B@b0rHNr4faB_H(A08_?$VYHl9s*AC6%5R(x9I2OQ2Y9QB7o{j$%rjq?9 z7l%hi9xnDDjJA*ctAfA?K1P^r#$4aU-JkhiE$~MeXk;%f9uw*MPU+yMtGhob_I-Kx zUz2V5Gh%onMis0}gHJY%6e!D~MsS>2%@Q$m8GbSKN24MK#6_vlav)^8H`(WB$nf&& zJ(s3)8B!U55cX4-0F8G;IpK&)MkFD^7O5B+uD_Sbg5-1Oh6yG*9L`(I%A zT;N|Zn*@%#rxu46dgLU-oq@?$UDnh;C2I;klp!{l=7vq9st_VvD+n`(P9Y_=yo9N0 z-imcGd$-L5n0j~@qE#4mO1RT8goHg2(Vx9iv_j$d`z78*$Zy5LPb-PRmUL+_0&N2v) zVoAkRDML1}rULj(vL@Jh_L?AtsJGjVhE?3%WLq6!6}W=cA=cG~MH_XN%`Ls&EY?_rp zbwZ0omc?vEQ=+^OVOo^y@R;&_8c-}c4IKvo^@M@Dz~#nHV{Jw?)|XeWT;IIDtr}ZbuCKQ?cGNQgg;-Gl|4xBz zi0YcFmoF<73T-sjTcOR3wVQYbffiVAZCz=FmK)nGb-BS2+{>F=Dln)JgOCA0s`4qA zY5XbID-yQZ+*-Y|y78RmPOw10+akg&RW4Vo3y50v67UHk;G{@zMvYt&Dp(_gQkhI> z(W)#!nm`USu-r{HtiWO(8F4OKWAi38F)JST(brM@R9Z1*n z>f*mV-ez`euMBjae%L=;6-w^x{sOU%xO!#Qs>6kwP_Gm(ATUp1L{-h!h^r`eFCHhv zWdZTmEaHlDGN@I?6M=5eN~5w;GU8~)VVN_(wxfkHxUuegG^ZO2h(#5ez`f#kEM-R1uePo;8V$!Am2VWdvJvDcG!;)z{kKnWXWXI!54(G!53LC z-S|>4l&x~Mq-71`JbMw0S$&c4GHLJt=d1hO7$IjSZ&842M$Bi5q{GghDPuMh2MgVvg%jI+a>3gpXb=7FM+n>QckVB632dJd%U+?2 z$hBMO-bcz#L&|n%Em$djJaHNaXBzc~pp`)oA~qxvyH_7p@RmrVLb}BO3N|nll30gz zj*;s_GIZK4LSu)?NRQ1dP$1&XSn!)kw;?*-Wmt#uY+fs$g}}8xc}pU%OmW{~x-I_& z3$tI|j__ZxMa4bQ*OK?+r~Dqjw&LrElHu=@RH3CA9|3fWq6?&p6?6t=jl&9dANBCK zj|k|?Lu3-P_B%Ineuv^ss%t)mq;~(&YLzDsfO^ibELTX`Px@H?FA5 zTbt`j`aP@Gs4~O27D(F$6g>E;L=3DmfeH{CL2QF);~jAzP8+k5Vdoz-{2aJm{It}8 zcCiFtOjYew{^K8JxUrJh{jacop_L_d4sq#*7@Q*gK>OLAV5KqnL3shVHTWTq2vS*K zu(o+cg~E7nZL77jbMs550&r{A8#^LPFN(YeO_b2K>@$Y3(qDcT>TW;g zkp6v|K`A2>135wO?r&1U{h{JoKV$pY2MY&B=G&vM{Pz6mJIJ5^w}MD(gmjr}AfR7C zhyvbq#7Jf%yCFJ@+2Sm@X>JrFuSm^?tq}ZWI7qFE3T;7-PN^WVZwijPUTbYkkx(Fj z>7o`u!|udT7!%nfK+_(=i$+34RLK%TC1zt-G1R0t!1fv>MZb%M_CxG9E%$XKFC(d0 z28sV*a`sl#)mONKQn_Nu@Bh?(ckKwjvh3Tv(+1$+CL6#}9!ttHV4=&@K=KSQgsuo+ zHu~WNX&L3p$x_{sU>|@HC_&Y!1i-09kODJxg}_)s=_r#CQA?q8y@DDDGa!SErRPzS zo-A8z$vw@glnRD0K`@<}qsFG7z-})a%0+mOB7hY7tjYz2!P88_`4TFPyvSHa_QDm6 z<|&ZpBy!EKr5Z!_p#Sx&KOY(C&m|F*Y!eoJlJB|w1;Nlf3%QpMjwa{xKVJ}uw|?(G z-r4;n&;gO8=@?;(SL)@tagri5LwGJ4J-~{-irCpk*jWSsntDD}KySWv%PQak9&#O= z;mUXsex_9rJQIzKv7cir3XlA9Q1As>5U=0C1235uPx?#BEs$gC!burcphi*`e!X)) z9CO(!d(MV^V7D-aQfwRob7RW)I2AA?%esCbWiI~TFEJ}p1{$z7#ouorLn8@I5k|@} zU0|Hz5f2DPDi7zG4*nFW!J&EPGyw*(FGb4uy@vjp2;M6q1M?VXU?@BIA1Dd)e~_=R z!_!D5RS~iyxvTS10yP`60xXBjgJ3EzRu!~T7dJ5MKmo!I?vSflY*=_#zAKU(u?J!U zBi^l2VadxC|BP*cRQs+LDNSt}-g-PK_Tmp*^1YK}g5j=iP2L$%ZuYr)cmHH^?Gf(w zJ~NB}moI-$IEbMwmrj1*A~)nHKOjQypGyz^5>>8H-J>=Q;1_BRB85z_GAbgB*sa#+ zRFh?5)rjaoBW>@9a3hW7Z4>vZquI_BLkQ|__0C*GTLwTzOyOG=o z^Ar!r2%!#CzeUQ;JW`D&s;tExp|k?3#Co5HLRYT0wzpw_vgd+wFW3}Dx+|I(+!9KV ztz6&QqWp$YouGPpM7hHT8%6qo&?_mE3#bS;i34qYfMl6O$!;YCc|wmbf;Ro4Ddl%$ zM9546_Dn*ql#-B)WEI6^C6YmXtKbp|M2%k1hnrqtt=r_{p$;J{FA@!kU}Cy3M8JBZ z2SW%x8v71V*QUOW4E>JQn3QR-q2n^nM6tzG0Yd9_Dneq85S?}YAxNviyhLb*{U7q9 zLc7^qmE_u&_r;))GVT4-y2SdGtJ0CV>gr#x_CmeGV|Km652=&^5{+ViMw2g%U5Jg0^HiwPk`Deg%-*pNZbX6qP3yyj5A?SOXf0hkqTfAu=U5s-Ln#MrszFo zUtu1@#-RX<3ui^Thx~<@*H={PF*irH3aa^NuK>}z$<9WJ@+mdT1tG9u&`F4{J74=( zAbY;`HgGZ0grjh*x0nQ4g@kf4~EEM@0?-tvm+|o(AALn`=FZ8{< zdkgqL*my2~(Ju8_;tWp}uCzBf0FIh;mD7Z$ZTB!dMP+imU!Y9_#P}xlf>1xKDZ4x@ zj6{SH1Q2HC64KPw2fmzs;2E7t{;Sz~#^T}`C*iC;Q7uC_UymRQlYsU`jn;yFZblUE z)hl;Eh`qW4)&NXOU58JGI=Rk)vn2XK!*A&aZ@)k?ALNV&C_VPHBM(E($f5+^TG`xc zz5N0d#%1K5x6uk0ftZzwLP(9cbIrm9m^<(Dk*PW?5TkMw3q%gqLg5%wJ?%pws!wN- zcdk=LB%)o7`_j9A74-o9$%Fpi+4BdOo@i`H`wqdO-h3sVTqCKcd6-M|Hc1upZ}GE zlM8))^!JhZzL&5;rs$?6+{+4)}P?b@TrYWC_A_8cxBhxI)#YTZ;3QEn) zR;Vfd%0(C0s3xoG{XqJj) z4YPJjS{N?67o07L(So&g6N0_c1g}*GcTEe`gmJi6VugA^NVwBLU5-`+(abb<(lxeP z2sWTNjAN|GUx2mbI*e-_XhOm(HH$qG$SqDx!JCz9GDOduJu`lWSTjndQ^{gQKw1Mi zXQ(__u|18EsfY?zTdh-Sd2^>d1`sDyFr5h%v!yyl;3uf^Xz$<=wiX4@KwJt#r@Pl$ z>+;Unpo);su6t3YjEoV|!_4QnL0xP>@jtksM4W1Du%SrVI0FMbf}s>Vt6orl<4Y=Z zMx6cr6L5=n1zs-mE{3{o2;$+8#Ig?c8-Tf4;Js$v6AnjV^oQr$Y% z*j^m$BJIQAMJI%iD`j>qyY?j3~)Uqwv zWI1#9JrRcp7JXJ4zO{J9)Z%^hFp0_E_6SIBNscTZ$sas9j{*05f8JSq7JvS1o(KM5 zWMVM6=lg-XU{Qo+rzjuNe~j>MFOI`X%^c;oFAeR6DLVKW>+xov|J!|jM?hJRlN9^M z^2cdDj*#J>TSM@|2iXhXySEA-eDB^0edaOi36^TCAC6rb?pVhT9<_$sqnA$njx~Jx z(y>tx@h zlkVC!E68J6PxpxXOQ$>O{m)rXTc^1PHVciiHMHmZhNqEn!d>`E%4GCsNxb)}1^FH? zk1s{3@MYJJSbpE*)~{+MV-!Y5kHOyo{;a2WKi~BG?*p&@4tR}T3Un-WaNG(2mg>@z z9c#4j(&*l={+$&#eMxn8{}=gMwh-{t zjX^?Fi}k4O)pJo+1m>5mcO119K`+Nzi%cA@Wndpd;%lxCBj)L5N?3)ECz2lw^9;pM z52G-oTTeh?A zba6x?wF--4M@^8gi#Jt~_pk>*MjrL36<-`E!FOX=a?mJc!VG%r+c8v&!DM!QDMrPX z?t9W+?t6-=7}bfqtWllNpU`?yq^4|L8YNI0Tq*k-iq$J=Jl4XvAa&fWS;_W>UUc3P zolFiir7*l2l=Lm&yS;gR3)&ZsGGZ@VH_2g^-Tbf=uu4Y<>!5?JVY{O;w542pSgdx| zT*{_WQms;CTuULJLLp%)f}gTq!PaH{hU{*{!Hl#Rgcr!-PV_)7+BBkimvWTR|JWjhVoLJY&9&$XhL2qTSQgGfu!^7DLV}6aVkd21Fj8YBjHD|dE~Dh&p{*pn?pXYn?_(){QL zf7crNqf&14M_()DN8iT|mA!k|wlU&=bgfT^c%d0RYM#{UU*-4Debf?m10Ul%^ZTLu ze@D!Qk<^fN;?m>&2VXqC0MOk&r2oR6?_2&$Pjp;!e!?^7j`cV_7l2w%IPkbM>Vl}} z!AU4C>m>K==phT=BirL$eINnMjlFxXe~dL2ZlCI%vm9q&uWg_`e4hpUx-)0Qvn^q! z-!=K&zeDwvQMH&t883XCQW-@RlQ2DNwWV=g?TUj1$XR3ey#_8p3Te{bLy~aRcmgp% zcf2hD`D3=4BoH;wDmVc(y&6Z2l4mV(D0%l<;vB-`wNzP(;Pei*%;OMLX0~yJkBor<73!XC3>z*@w-{z( zx?v`sZio-*Nygya$RuN^9HL3a;8N-q$A=|tz>AJz1pR6hhLLoP0)D0uaUydGZK|Im zLPVdA0(J5g;LP;0p%`(X7;&H&v7tyVB7G&oz6WK_@s+yR8xg2dlDN)((l9b2bQ+Do zk)A;oyKo+Ma8BVeH+aJEG7S{jZqkQvU=^Njh$``FC^w^5L!}+E<}ehhZp30pSBoJd zTU`*Yqb5)83z+C>1Hl+L8LYsx&?A@@LwqobCIJVoSWUp75+4+HR?J*RU`E)Q1PUf$ z9>6iznGt!3?5hM-by!G{Y@rIHv2g{38ti93tFCX8`^%IWs%EpWOMsGqSTMBRN)GMO zoi{eQ3Avr^&5do8kVh$0m)2j@FNwaF@6V9+L1T*{rbk8D2V#G)B~s0%nF+OlUyZZP zDPuNCJZr&w_?Tld=!arCq%+p+{A|5evr33aXqTJ?hy_d{a}7eUsN5VtUMfp0TuYmL zEn6fFPc}e#iSBR%%L3{g7bfy8rRwn6ajF4jEJ1468iF%i$e+g8(B}UaGO*93hW#l= zCGyqUAPf1CuMOsIBTm=%XRgkDer~$`8Zs)r*YEPp_j7&zS99cXUK$byo1d;7`Ni76 z-S6)C|EL5l^)qV-zdtFVTc7{S))4>Y_kBMpYL|OIAl3rg6Y#tEueoWD?)m-+&+qOZ zw)cGBEXwu%XSoCGa@}?J&61z*okm{J{weNIZ0;X#uHOA&bok&i{0+p}WvKS(?u>Nd zU)B}H=IztyeM_OcR9RB@-z)vGHFSG~yYUa&+M^#X{7Hcz;(vz$@I@D3xl_*1pMnuoIAFg%NI(A~9)0{tnNAoA1?g&6mD06YL^LlgRZ{BNSm{B<7=zrqGV29VI zVF%#;uv7Bu{RT9NVL_WzEJ_waM{I|^Sh@-%-8<)+>_6DMH|54TLJJz$PYQzgeFsK- zwfkGr=k}9)dsr6+(#w0l`b+aUm=r^1%CEVn+a5MuPH1Ia@}n!G(SG!K_ah#h!8@$y z@f)Rsqt;OK9ifF``P13`pHT7$`Pt$G$8u0~6#*#{E^3n9WkhD^L`R`#*DQ(NndyD6dtBsZx=@IEYHW|h|3}; zBOG2wRGEh)mk+H)oUeuBt|)01M__;@&v*tZs*qZO?1@9kbik(NcT{>&mE5KKsY5LL;s^Mbun*SI{*( z_?9I2WG52WwDo`i)md&}k+y=jEcVSLX|+@(g`-{UK!;d!oPly%L@I%x03>c6C&wkQ z4jY+JxTrnI)esOsmN`3z3uI@3cSJ7{>8uywoyP&<6dbO?5`1*2<7Tvo2B^ZpCLr>+ zV+bo~c*Ety!FMT?r4rat+L-~qVif)<5Qd9o?6RYZC<)R=K^0#a=%=ovGJfkT&`U9O zzD`An5nx8H!Z6)ZXOZ~2rsear$E+JX6~6D!r0WdkX@R!Qk4v4pWW+&*%ZBnM!i2N|Tbix?{c2-u@@168jc_9~|ebl2>~6yS$SQHq@f zvTrulS2tQpha)gW*ouSZvwC9MQpYP0E%pHRD>}hw2WpIwffE2IyFyk5!e(?yrUI3c zQF0O0e-w=;83Ni(vEe{QtR&Lu3Xuy$BXkmSO!?l%NmBiEsDYm~IsaVT586lAh`0H{ zEDPgjmj01s&ZYkE19_=WUcI<~GGz|Fk+<%cw@^}c(4Sm5=%-Ylq}!xu@Xqf4Kv9zu z5rvyzl5P^(Gj$erW({d#(}N6YQ@jNF1hJU_AnK4b6%*Zt!ABJFqb!gq4RqpVx`HCA zz#a@dCu&P(7x5z-X=HfSX8Dr#a+I|_MjI6kTqQn)Ul?~9H3V!y*qHK{eGmBtQm~s2 z22!>vexf6r*w`TRKRYW~Pg^-Y(UB8gPb(t^AnEMMdxt=LL@Kc|aNqRrXmI-BTp^U0I zt6s>!f{v0fn;n3i2{Xs(24uBLPd=S$cC73tR|9+Nul0K@c-`WfaL6$4ex6 zd@g?>JMOj_BJc;@N9aZ1$aYO70>V6eDiLThdsv4bBG7)$uoNck88(cWk!OdKA0brT z6ClCTH32#wv3tc~gxAf`Vephz_F*`EJ%b@gB4c4t_fXIbUDu8s*eHH;z$mR(=3`3`tAVQ<6JIEe}C4lDyBs!JNyo*>qJYb3I zBiN3}i;3}*IEcW-52zRMUj$Zyb{9EGpuI{8G?Px!XGGfRS!fw~4ViiK8ik_0{WzOk z$4-`KbVh(y@(gxi;_S*s6Z(x#*OU)Yw%>dRr76&V_kV9}&}_yQO+YdTm~uv2@T?>eNkSl;bFzc_SD z5|KG^E%wC^tUD0U4>~zXd$w1Gd8@B%!WT)|mioy%7j7Nr_ZI9b+*|K0e2_nQ6dN{{ zezg0$^QYh6{RXraWu?p!kVyNvH~xY<%oaqL-%@@Fk3w^nQ@IQCH*3v7lLIz#!a})* zB3A>508eNx3C`|}A;zs7b^*g$-!jVWdjoUCNMGu&%usHH`8GLkeM-mLz=j z;)SoM%!haPgHSY!EYe&(9YM7tB(J;gZo-UVI?ae`^V66hpPU)dZgH*@#BvN=@ltK|dNRxz?x zOaVX5(O9n}0G)&8%%mx0X$CPz7;m=-ut6NW4by`>326Qrp%+JWFI39c;u6AhS&dYZWzCOVxsvf*^)7s#uCxa~%C9>!)h!eNdM+rUq#&9BJ-q z1lf5UY<#>1P-JE(|@1kj!wbKzjg?tDf za#cWD9lJYQD@K283$9qESJjpE6}7y)qONUGhh??=qWz}*jlsYiTzNdk9*XU2o7m;K zvBO`XBj+W4V$4T^m)k-&xN|oWmC>6rZSWN!t6T@)LK?_njeH?=BB$FEE9i4qIpwd9 zwx&V7d%SxGsJcd=2?&Y1rvQrg+-d@o`3XDdYo?4YID;J=6>S5DW(HECv-s$ePo9$t zC`P&v!72$Oy0_1|q8o6U_&Ls2dVQ7*zw0Tz;TD1q7ohjzFfhACC!wR-QA3{wuy?WZ z0G_xgJ$CQirhAzz$lSRx+lA}_Q38T;4$nyZaqNif+Jwg=nEjJw{-$>ivuQHJ+GE&+ z8CcZ2jA&Ijl1Tp_5IiY28m4sddC^mAsaO>tk8APjg_vpd zmWVQR>_?`y1t0OIt@x`>fJxs{z+yqR-?a2 z?26i9jq^!Vk6wsdR_Z1lLNkhpHP4_U){HWIk+5zHv|hFIDYed^h?9?2JFJ;s^a^B` z?h(!Hnrx2-a`iA8L~C*hc?Lg1_Z;%R8>*j718GZx=i94>V4^tc#YpTf73Aq-qli1% zcbFdrLKqz=XYwND64U~IT&k)__Oj?SJcSA{+Mu_M0}56z3#x#5DZDkMG;hWkJ0XwQmB zRR%>Mne4CL8FI+FBCefP~X5Q3s| z=ar%2w;IWA7&RUv6(>3n!gEN!WukRxiQeg(b#kJjhtU zsyOC>az*PG-n(g24YvLSw8HKczTPhh`*~)?c<;hA8ABS=&Pw%h7K}id*|-O(ph@pe z(`Qu;Tag+Y+eEH7hQsVYRY5r{;|6fvLQG2CXyFjf78Z2_m6;e&D)P_6=9cOg8|Ey! zNLt&c26wZ#r=eUb=6bpe$_{5xJqrcw;gyk1qFraU^Z3OB|{)@+u R>$ReEC%k>ADaE^p|34!JLvH{8 literal 0 HcmV?d00001 diff --git a/lispusers/GITFNS.TEDIT b/lispusers/GITFNS.TEDIT new file mode 100644 index 0000000000000000000000000000000000000000..21ecd5e6ff395e3c3b686b98f36d88ca2ed91a87 GIT binary patch literal 11034 zcmeHN+iqjYb)|aRj?Hn$iJb%vYy*|H;gAVMb!&Qh#_fR|jzo3SO_2&od1h?*;qb5| zp6FbdbCH@J%%finI8Q;I@&N(z90UkpKRZ8=&&W4qtz8!$vM<2^ejEWU@zkl>wJ&S0 zy{p(~dJ*gOSDy}Mr=#g%^WLN8y@$Q9{NY+nvQ#|}R&kKtn=PY4EwZpmbXuz0 zpip71gHkV4l&YTuX%*yar4An)9(M0pIclCqiz{8Ixh`+DPF1MAP#x=@!t`19>-GnWaTnsX?;J@-j%vc->LP1uBS(48P*+7RqM1O0rzT(o)B9bVUz@ zS+WZ9sDKD>-!Ljxs>rH5)M8=LndwDT+RvhWsbAP<`fU+iUh16U;1;+mNW&%kMKhhx z=&6EpgW4P;3f_#f5Y`))sM{>Rj?ybg&2?C2`MRr`GfXP8EEW+ZW4H>!>)=YOq$)~v zoo2TZ7AuLnsbXD}I>AJE5R2t~7-y-3$i@)fUu8vPc2NQjnU4)P<0gnJKm7)N3g!?D z-=6hPhW$@Y1{3(b{;0wrh0Us1=`gyC46G=rDs+xu4@QHT_)#Gk@Rgmu%Cj4QKtRaZ zMH%GfeuXH6d9*4OU>c~4GH2C;4V;I060XPhPxvT)(xn37Wc?nAz zB#dqiyQ-zTS6vw30A93VST9xjMUbrEa2pMYjM?ho0{$!xt|h4thJ?>SA{q5g_uT`a zaNj%~bOky@^d?V5jXLm|8L+F0DHzylLJ>umkjncmk|}is5G>y*M}?pPlz6ePl@gcs8C4`cupU3+Y@o zCTI*Lh|-2YJXwHIucGuo_7EW1fh0gi=Url+0ty|2AYhb{M0dYTT{81nSPnoUA;1N0 zd#@9yx>90Iv9wg;NG)`{^^$SZ@x|nLV_26E@Lb4c#FeC^$&7Nn!l3aPw8usW3mNex z$+P~)GpAcuf^Snmcm+7zU=R#QP6wH50(3qPi9rGbI5SkdZ~j

bB@*P{+tQXBc`; zfz#Uzn;Q~;(xgQD_z(~w2{Vef%wkuvAxCXAR}UcV5h<^6Pk4vL6X$Sx+-Te1Nothh1blQ%9XW_Y+Gp1 z*J6uScOXiPnyLo1(=6Q|4TiFo@ixjp67rP^nrfsZGD8*|uryd{NHx9EDJz4RZnYt;j4%~aQ= zGjeleUt&4NI&Rx<3AWe}xYX3G8i$BvCbq(3(B+@P~Lkj~9=H~6MXi{O%-E{-U!8>k;9AT?Wo=S%Nj zlf*V-4JVkq-D+%YXKiuFChm2o4xQdad6vr2MfgeLjUDOl=xRw;w1IVPJ5{jFwm6=C zh}>C(wk!i_Wzr%7GvSaBgeZ=lhUy0mho%h|<&^=GY36}%WF91GQFmgCD$!;(! zi+vvwm)VsTLT7s)lZ@eoDh0Y0QCP|uVi6V4H%0$K>SW&r3SI`eOvSkeGGSewC6drX>BECeEiK4nWwHnh4O`a`H zJ=p>@S=qq31sBy1T4-Y69ISVtutvMXqqV!9Jid~dM$Mg}lt1=}kArKT@Bvx|l;Y*o zfdPK@n!0Vg%&mT=qdq;EKL6~43%0^X=8$qECHM#wjtdJMQjU_fJ)<0{)`kIYH4ud= zO%=G~OB<2B@1LzLJKX1EChfl<=l)Z8%-DXPhbZZqOec$Wlpd=)QK5tZXa+EFu=6Hy z#WNhR06PR3g3&a~6ZDwYw?6K*c;eW^+Xu2V6hZkXl_JAjGtEnb6e5ah?p+5pTQitS zrpe)-h)}?UqU6B>WQEKqkQ!iB2{N>@eIu$y1~|n$21qfon&mhc+~6X_W@$Yi(7Exx z#1V~Q%o>Ar)Es?=u~uWpTBpOFyQ|oVYVQJj4mYj7w+J{1axe*@Q>a$$5Y$n_!SwuM z+Mi6fMo-71+17wA!){w_6879+6!FHX4H$`D7(X*;b(q%~JOP^7ei}^a6fuRz>JWhQ zdr0ItZc`*`;09cm;H;Y#L?QA#N->t8qQz5dpp$@|+ zb}7l)<(AXg-ZOC}OB)+awiO1D_JYmys-B#D0?J;Sq;nTK_Kd=|o$jQ&5+3~NG@tlv z4ZwVwJ+3*jJ!x`UJv*q>ZrdP9jaqKX6U*1;V9l0H5FuA`Y!kfB91g<_XPaV$(+l6Z zu+`Gh`A=rQsoMcG#4bnC2p{_29ZAU540QkzeCZy_)cpd7Uvzn>P5uxpO(LXXZExrf zP2LI`xbgnZcBBe&16#0ea{%U9;Np_VwRCFzZ1UB(pMD@*gvS+XM4QOLxYsb(uiO)5gW${3gL>Mo*$B$c(9=X;tdN!z zQqVMRR#GLDSDoh>?&VJ1B|j}hNcIf@Gb^nZHW@!7D$IGHASZmk`8VF;3(u8 zJX*h^E%x`#9+EmHtWwobD){9M%cLzPB??=0WhlQYkT0}^*R9gsTn0E$bepFFOn!HR zZ;nDBz^RI=oA`{mK(ZYG zKX9^vt?l@vOS5dg>CnV! zV62+<`w(e?+3-PMx!x?QFhuNl`UC@idUp2N2RloFLgt>p%AS$&otCFD5CIFHt$Q16 z%KTUC%3a{!&kpQ1xX`ACVB=wQjY3f{Z{bN>3{M?F!-}~Vqo?5cT z$(!_s!(m^IPfyjf zKg5>-=TKoL&*ziz3TG<{pN!P_r~S!rFtP$>lfm=;_`)o| z7-5Eg*Z=suH<}K{BQ@ziy%_c;YC0UB_x;mH{lU{`GamK^7iUzgKXE&=9T&Io%5FOQ z1nS~b8~&P{_28YF!{CyK?>$oQJXVMAzmGp{Gqd%q-#dXDjic=SN(F&g0ohp_hj zN9w&tkJP(|^|f-@&#n27Q-1hZJ$m=Cdi>yl5#Pqj&lOh8|00ZEgi*D=$VTN-^ADJf z?Y2D@cf=Z!x<;ag}TKRepLO~$cI)_A){V`la%e&2~lDGqq; zw&Kr+KXFpN!w;15w{FB6DI)pn9$#_JJN&>AK>Nfkw14Mf_D*y3EaHn zrg*c*Zp2yHa*N%-x7`fCwO7wu>0{s)c}INRiF@0LaZ^5UZ*JWikxNUwU!9tJ-*9u> z>XY382^SZ;8Q#$z1>baQL_X(!-;KD9HsN{0$kMIy3jdWG@scHSeDCMHaC5xme|IBJ z<-gk<5VPw>?ZWBK|LiXD)=u0T53A>H#K+B#{EDx*kzj{9`&HlLD~>q5_q=DF-VfZA zC;UJ$9(jH%A226)?{C~HC+2c@KmtZ_o}0b6T}L$j)h!m1;vz{fDlUA$5syJi&7(iJf ekJdU%e!!0$@Lrs{k$>X{Ecou-#_xXlU;hV5Q0(jg literal 0 HcmV?d00001 diff --git a/lispusers/PSEUDOHOSTS b/lispusers/PSEUDOHOSTS new file mode 100644 index 00000000..1bd602d9 --- /dev/null +++ b/lispusers/PSEUDOHOSTS @@ -0,0 +1,438 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) + +(FILECREATED "27-Jan-2022 12:35:16"  +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>PSEUDOHOSTS.;119 22617 + + :CHANGES-TO (VARS PSEUDOHOSTSCOMS) + + :PREVIOUS-DATE "26-Jan-2022 23:33:17" +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>PSEUDOHOSTS.;118) + + +(PRETTYCOMPRINT PSEUDOHOSTSCOMS) + +(RPAQQ PSEUDOHOSTSCOMS + [ + (* ;; "Public entries") + + (FNS PSEUDOHOST PSEUDOHOSTP PSEUDOHOSTS TARGETHOST TRUEFILENAME) + + (* ;; "Internals") + + (FNS EXPAND.PH CONTRACT.PH SLASHIT UNSLASHIT) + (FNS OPENFILE.PH GETFILENAME.PH DIRECTORYNAMEP.PH CLOSEFILE.PH REOPENFILE.PH DELETEFILE.PH + OPENP.PH UNREGISTERFILE.PH REGISTERFILE.PH GENERATEFILES.PH GETFILEINFO.PH + SETFILEINFO.PH NEXTFILEFN.PH FILEINFOFN.PH RENAMEFILE.PH) + (P (PSEUDOHOST 'LI LOGINHOST/DIR)) + (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS PHDEVICE PHGENFILESTATE) + (MACROS PSEUDOHOST.NAME PSEUDOHOST.TARGETVAL) + (P (CL:UNLESS (GETP 'EXPORTS.ALL 'FILE) + (LOAD 'EXPORTS.ALL))]) + + + +(* ;; "Public entries") + +(DEFINEQ + +(PSEUDOHOST + [LAMBDA (HOST PREFIX) (* ; "Edited 25-Jan-2022 09:58 by rmk") + (* ; "Edited 23-Jan-2022 20:43 by rmk") + (* ; "Edited 18-Jan-2022 13:08 by rmk") + (CL:WHEN (AND (LISTP HOST) + (NULL PREFIX)) + (SETQ PREFIX (CADR HOST)) + (SETQ HOST (CAR HOST))) + (SETQ HOST (U-CASE (MKATOM HOST))) + (IF PREFIX + THEN (CL:UNLESS (FILENAMEFIELD PREFIX 'HOST) + (SETQ PREFIX (UNSLASHIT (PACKFILENAME 'HOST 'DSK 'BODY PREFIX)))) + (CL:UNLESS (MEMB (NTHCHARCODE PREFIX -1) + (CHARCODE (> / <))) + (SETQ PREFIX (CONCAT PREFIX (IF (STRPOS "/" PREFIX) + THEN "/" + ELSE ">")))) + [LET (PREVIOUS TARGETHOST TARGETDEVICE) + (CL:WHEN (SETQ PREVIOUS (PSEUDOHOSTP HOST))(* ; + "Redefining: first clear out the previous one") + (PSEUDOHOST HOST NIL)) + [SETQ TARGETHOST (U-CASE (FILENAMEFIELD PREFIX 'HOST] + + (* ;; "We know about the directory separators for these particular devices. Maybe there should be separate list of slash-hosts somewhere that we can use.") + + (SELECTQ TARGETHOST + ((DSK CORE) + (SETQ PREFIX (UNSLASHIT PREFIX))) + (UNIX (SETQ PREFIX (SLASHIT PREFIX))) + NIL) + (SETQ TARGETDEVICE (OR (\GETDEVICEFROMHOSTNAME TARGETHOST) + (ERROR "UNKNOWN TARGET HOST" TARGETHOST))) + + (* ;; "Save the last directory marker to pack on if needed.") + + (\DEFINEDEVICE HOST (CREATE FDEV + USING TARGETDEVICE DEVICENAME _ HOST FDEV1 _ TARGETDEVICE + FDEV2 _ (CONS PREFIX (CL:IF (EQ (CHARCODE /) + (NTHCHARCODE PREFIX -1 + )) + '/ + '<)) + OPENFILE _ (FUNCTION OPENFILE.PH) + GETFILENAME _ (FUNCTION GETFILENAME.PH) + DIRECTORYNAMEP _ (FUNCTION DIRECTORYNAMEP.PH) + CLOSEFILE _ (FUNCTION CLOSEFILE.PH) + REOPENFILE _ (FUNCTION REOPENFILE.PH) + DELETEFILE _ (FUNCTION DELETEFILE.PH) + OPENP _ (FUNCTION OPENP.PH) + UNREGISTERFILE _ (FUNCTION UNREGISTERFILE.PH) + REGISTERFILE _ (FUNCTION REGISTERFILE.PH) + GENERATEFILES _ (FUNCTION GENERATEFILES.PH) + GETFILEINFO _ (FUNCTION GETFILEINFO.PH) + SETFILEINFO _ (FUNCTION SETFILEINFO.PH) + RENAMEFILE _ (FUNCTION RENAMEFILE.PH] + ELSEIF (PSEUDOHOSTP HOST) + THEN (UNINTERRUPTABLY + + (* ;; "\DEFINEDEVICE removes the name-mapping but doesn't remove the device. Maybe that's on purpose for other devices, but not here.") + + (SETQ \FILEDEVICES (DREMOVE (\GETDEVICEFROMNAME HOST \FILEDEVICES) + \FILEDEVICES)) + (\DEFINEDEVICE HOST NIL)) + ELSE (ERROR HOST "is not a pseudohost")) + HOST]) + +(PSEUDOHOSTP + [LAMBDA (HOST) (* ; "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)))]) + +(PSEUDOHOSTS + [LAMBDA NIL (* ; "Edited 17-Jan-2022 18:15 by rmk") + (FOR DEV IN \FILEDEVICES WHEN (TYPE? FDEV (FETCH (PHDEVICE TARGETDEV) OF DEV)) + COLLECT (LIST (FETCH (FDEV DEVICENAME) OF DEV) + (FETCH (PHDEVICE PREFIX) OF DEV]) + +(TARGETHOST + [LAMBDA (HOST) (* ; "Edited 22-Jan-2022 09:00 by rmk") + (CL:WHEN (PSEUDOHOSTP HOST) + (FETCH (FDEV DEVICENAME) OF (FETCH (PHDEVICE TARGETDEV) OF (\GETDEVICEFROMNAME HOST))))]) + +(TRUEFILENAME + [LAMBDA (FILE) (* ; "Edited 26-Jan-2022 23:33 by rmk") + (* ; "Edited 25-Jan-2022 08:47 by rmk") + (LET (FILENAME DEVICE) + (IF (STREAMP FILE) + THEN (SETQ FILENAME (FETCH (STREAM FULLFILENAME) OF FILE)) + (SETQ DEVICE (FETCH (STREAM DEVICE) OF FILE)) + ELSE (SETQ FILENAME (\ADD.CONNECTED.DIR FILE)) + (SETQ DEVICE (\GETDEVICEFROMNAME FILENAME))) + (CL:IF (TYPE? PHDEVICE DEVICE) + (EXPAND.PH FILENAME DEVICE) + FILENAME)]) +) + + + +(* ;; "Internals") + +(DEFINEQ + +(EXPAND.PH + [LAMBDA (FILENAME PHDEV) + + (* ;; "Edited 26-Jan-2022 11:06 by rmk: that FILENAME contains }, because HOST was identified in it. If FILENAME is a stream, expand its full name") + + (* ;; "Assumes that FILENAME contains }, because HOST was identified in it. If FILENAME is a stream, expand its full name") + + (IF (TYPE? STREAM FILENAME) + THEN (CL:UNLESS PHDEV + (SETQ PHDEV (FETCH (STREAM DEVICE) OF FILENAME))) + (SETQ FILENAME (FETCH (STREAM FULLNAME) OF FILENAME)) + ELSEIF (NOT (TYPE? FDEV PHDEV)) + THEN (SETQ PHDEV (\GETDEVICEFROMNAME PHDEV))) + (LET (SUFFIX SUFFIXPOS) + (CL:WHEN (SETQ SUFFIXPOS (STRPOS "}" FILENAME)) + (SETQ SUFFIX (SUBSTRING FILENAME (ADD1 SUFFIXPOS))) + (CL:WHEN (FMEMB (CHCON1 SUFFIX) + (CHARCODE (< > /))) + (SETQ SUFFIX (SUBSTRING SUFFIX 2))) + (CONCAT (FETCH (PHDEVICE PREFIX) OF PHDEV) + SUFFIX))]) + +(CONTRACT.PH + [LAMBDA (NAME PHDEV) (* ; "Edited 25-Jan-2022 09:44 by rmk") + (* ; "Edited 20-Jan-2022 20:04 by rmk") + (* ; "Edited 18-Jan-2022 22:54 by rmk") + (* ; "Edited 16-Jan-2022 19:57 by rmk") + (* ; "Edited 14-Jan-2022 00:03 by rmk") + (CL:UNLESS (TYPE? FDEV PHDEV) + (SETQ PHDEV (\GETDEVICEFROMNAME PHDEV))) + (CL:WHEN NAME + (LET* [(PREFIX (FETCH (PHDEVICE PREFIX) OF PHDEV)) + (CONNECTOR (FETCH (PHDEVICE CONNECTOR) OF PHDEV)) + (SUFFIX (SUBSTRING NAME (ADD1 (NCHARS PREFIX] + (IF (STRPOS PREFIX NAME 1 NIL T NIL FILEDIRCASEARRAY) + THEN (CL:WHEN (STRPOS ">" SUFFIX 1 NIL NIL NIL FILEDIRCASEARRAY) + + (* ;; "Must be a subdirectory. (CDR INFO) tells us whether to use / or > depending on what the prefix has") + + [SETQ SUFFIX (CONCAT CONNECTOR (IF (EQ CONNECTOR '/) + THEN (SLASHIT SUFFIX) + ELSE (UNSLASHIT SUFFIX]) + (PACK* '{ (FETCH (FDEV DEVICENAME) OF PHDEV) + "}" + (OR SUFFIX "")) + ELSE + (* ;; "If the target's NAME didn't begin with the prefix, then the caller must have jumped outside the pseudo root. So just return the NAME") + + NAME)))]) + +(SLASHIT + [LAMBDA (X LCASEDIRS) (* ; "Edited 26-Jan-2022 15:08 by rmk") + (* ; "Edited 3-Jan-2022 11:44 by rmk") + (* ; "Edited 22-Dec-2021 20:18 by rmk") + (* ; "Edited 2-Nov-2021 22:54 by rmk:") + (LET [LASTDIRPOS SLASHED (DIRPOS (ADD1 (OR (STRPOS "}" X) + 0] + [SETQ SLASHED (CONCATCODES (FOR I C FROM DIRPOS WHILE (SETQ C (NTHCHARCODE X I)) + COLLECT (SELCHARQ C + ((< >) + (SETQ LASTDIRPOS I) + (CHARCODE /)) + (/ (SETQ LASTDIRPOS I) + C) + C] + (CL:WHEN (AND LCASEDIRS LASTDIRPOS) + (SETQ LASTDIRPOS (ADD1 (IDIFFERENCE LASTDIRPOS DIRPOS))) + (SETQ SLASHED (CONCAT (L-CASE (SUBSTRING SLASHED 1 LASTDIRPOS)) + (OR (SUBSTRING SLASHED (ADD1 LASTDIRPOS)) + "")))) + (CL:IF (EQ DIRPOS 1) + SLASHED + (CONCAT (SUBSTRING X 1 (SUB1 DIRPOS)) + SLASHED))]) + +(UNSLASHIT + [LAMBDA (X LCASEDIRS) (* ; "Edited 26-Jan-2022 15:09 by rmk") + (* ; "Edited 22-Dec-2021 20:18 by rmk") + (* ; "Edited 21-Nov-2021 23:00 by rmk:") + + (* ;; "Tricky to get the first one right.") + + (LET [LASTDIRPOS UNSLASHED (DIRPOS (ADD1 (OR (STRPOS "}" X) + 0] + [SETQ UNSLASHED + (CONCATCODES (FOR I C LASTC FROM DIRPOS WHILE (SETQ C (NTHCHARCODE X I)) + COLLECT (PROG1 (SELCHARQ C + (/ (SETQ LASTDIRPOS I) + (IF (AND LASTC (NEQ LASTC (CHARCODE }))) + THEN (CHARCODE >) + ELSE (CHARCODE <))) + ((< >) + (SETQ LASTDIRPOS I) + C) + C) + (SETQ LASTC C] + (CL:WHEN (AND LCASEDIRS LASTDIRPOS) + (SETQ LASTDIRPOS (ADD1 (IDIFFERENCE LASTDIRPOS DIRPOS))) + (SETQ UNSLASHED (CONCAT (L-CASE (SUBSTRING UNSLASHED 1 LASTDIRPOS)) + (OR (SUBSTRING UNSLASHED (ADD1 LASTDIRPOS)) + "")))) + (CL:IF (EQ DIRPOS 1) + UNSLASHED + (CONCAT (SUBSTRING X 1 (SUB1 DIRPOS)) + UNSLASHED))]) +) +(DEFINEQ + +(OPENFILE.PH + [LAMBDA (FILE ACCESS RECOG OTHERINFO FDEV OLDSTRING) (* ; "Edited 25-Jan-2022 08:45 by rmk") + (* ; "Edited 18-Jan-2022 10:29 by rmk") + (LET ((STREAM (PSEUDOHOST.TARGETVAL OPENFILE (FILE ACCESS RECOG OTHERINFO FDEV OLDSTRING) + FDEV))) + (CHANGE (FETCH (STREAM FULLFILENAME) OF STREAM) + (CONTRACT.PH DATUM FDEV)) + (REPLACE (STREAM DEVICE) OF STREAM WITH FDEV) + STREAM]) + +(GETFILENAME.PH + [LAMBDA (NAME RECOG FDEV) (* ; "Edited 25-Jan-2022 22:56 by rmk") + (* ; "Edited 16-Jan-2022 20:27 by rmk") + (PSEUDOHOST.NAME GETFILENAME (NAME RECOG FDEV]) + +(DIRECTORYNAMEP.PH + [LAMBDA (DIRSPEC DEV CREATE?) (* ; "Edited 25-Jan-2022 22:56 by rmk") + (* ; "Edited 18-Jan-2022 11:32 by rmk") + + (* ;; "{FOO} by itself is always a legitimate directory--you should be able to connect to it when you are starting up") + (* ; "Edited 16-Jan-2022 20:35 by rmk") + (OR (EQ (CHARCODE }) + (NTHCHARCODE DIRSPEC -1)) + (PSEUDOHOST.NAME DIRECTORYNAMEP (DIRSPEC DEV CREATE?) + DEV]) + +(CLOSEFILE.PH + [LAMBDA (STREAM ABORTFLG) (* ; "Edited 16-Jan-2022 15:38 by rmk") + (APPLY* (FETCH (FDEV CLOSEFILE) OF (FETCH (PHDEVICE TARGETDEV) OF (FETCH (STREAM DEVICE) + OF STREAM))) + STREAM ABORTFLG]) + +(REOPENFILE.PH + [LAMBDA (FILE ACCESS RECOG OTHERINFO FDEV OLDSTREAM) (* ; "Edited 25-Jan-2022 12:50 by rmk") + (* ; "Edited 18-Jan-2022 11:41 by rmk") + (LET ((STREAM (PSEUDOHOST.TARGETVAL REOPENFILE (FILE ACCESS RECOG OTHERINFO FDEV OLDSTREAM) + FDEV))) + (CHANGE (FETCH (STREAM FULLFILENAME) OF STREAM) + (CONTRACT.PH DATUM FDEV)) + (REPLACE (STREAM DEVICE) OF STREAM WITH FDEV) + STREAM]) + +(DELETEFILE.PH + [LAMBDA (FILENAME DEV) (* ; "Edited 25-Jan-2022 22:56 by rmk") + (* ; "Edited 18-Jan-2022 10:23 by rmk") + (PSEUDOHOST.NAME DELETEFILE (FILENAME DEV]) + +(OPENP.PH + [LAMBDA (FILENAME ACCESS DEVICE) (* ; "Edited 18-Jan-2022 10:29 by rmk") + (PSEUDOHOST.TARGETVAL OPENP (FILENAME ACCESS DEVICE]) + +(UNREGISTERFILE.PH + [LAMBDA (DEVICE STREAM) (* ; "Edited 16-Jan-2022 16:47 by rmk") + (APPLY* (FETCH (FDEV UNREGISTERFILE) OF (FETCH (PHDEVICE TARGETDEV) OF DEVICE)) + (FETCH (PHDEVICE TARGETDEV) OF DEVICE) + STREAM]) + +(REGISTERFILE.PH + [LAMBDA (DEVICE STREAM) (* ; "Edited 16-Jan-2022 16:46 by rmk") + (APPLY* (FETCH (FDEV REGISTERFILE) OF (FETCH (PHDEVICE TARGETDEV) OF DEVICE)) + (FETCH (PHDEVICE TARGETDEV) OF DEVICE) + STREAM]) + +(GENERATEFILES.PH + [LAMBDA (FDEV PATTERN DESIREDPROPS OPTIONS) (* ; "Edited 17-Jan-2022 20:46 by rmk") + + (* ;; "FDEV is the pseudohost. We will generate from the target directory using its GENFILESTATE, but fiddle the output so that it looks like it is coming from the pseudo host.") + + (LET ((TARGETGENOBJ (APPLY* (FETCH (FDEV GENERATEFILES) OF (FETCH (PHDEVICE TARGETDEV) + OF FDEV)) + (FETCH (PHDEVICE TARGETDEV) OF FDEV) + (EXPAND.PH PATTERN FDEV) + DESIREDPROPS OPTIONS))) + + (* ;; "The TARGETGENOBJ contains the targets functions as well as its GENFILESTATE. We need the ph FDEV to contract the generated names") + + (CREATE FILEGENOBJ + NEXTFILEFN _ (FUNCTION NEXTFILEFN.PH) + FILEINFOFN _ (FUNCTION FILEINFOFN.PH) + GENFILESTATE _ (LIST FDEV TARGETGENOBJ]) + +(GETFILEINFO.PH + [LAMBDA (STREAM ATTRIBUTE DEVICE) (* ; "Edited 25-Jan-2022 12:43 by rmk") + (* ; "Edited 17-Jan-2022 18:21 by rmk") + (PSEUDOHOST.TARGETVAL GETFILEINFO (STREAM ATTRIBUTE DEVICE]) + +(SETFILEINFO.PH + [LAMBDA (STREAM ATTRIBUTE VALUE DEVICE) (* ; "Edited 25-Jan-2022 12:37 by rmk") + (PSEUDOHOST.TARGETVAL SETFILEINFO (STREAM ATTRIBUTE VALUE DEVICE]) + +(NEXTFILEFN.PH + [LAMBDA (GENFILESTATE NAMEONLY) (* ; "Edited 17-Jan-2022 21:27 by rmk") + (LET* ((TARGETGENOBJ (CADR GENFILESTATE)) + (TARGETGENFILESTATE (FETCH GENFILESTATE OF TARGETGENOBJ)) + (FILENAME (APPLY* (FETCH NEXTFILEFN OF TARGETGENOBJ) + TARGETGENFILESTATE NAMEONLY))) + (CL:WHEN FILENAME + (CL:UNLESS NAMEONLY + (SETQ FILENAME (CONTRACT.PH FILENAME (CAR GENFILESTATE))))) + FILENAME]) + +(FILEINFOFN.PH + [LAMBDA (GENFILESTATE ATTRIBUTE) (* ; "Edited 17-Jan-2022 20:52 by rmk") + (APPLY* (FETCH FILEINFOFN OF (CADR GENFILESTATE)) + (FETCH GENFILESTATE OF (CADR GENFILESTATE)) + ATTRIBUTE]) + +(RENAMEFILE.PH + [LAMBDA (OLD-DEVICE OLD-NAME NEW-DEVICE NEW-NAME) (* ; "Edited 18-Jan-2022 09:52 by rmk") + (LET ((OLDTARGETDEV (FETCH (PHDEVICE TARGETDEV) OF OLD-DEVICE)) + (NEWTARGETDEV (FETCH (PHDEVICE TARGETDEV) OF NEW-DEVICE)) + (NEWTARGETNAME NEW-NAME) + RESULT) + (CL:WHEN (TYPE? FDEV NEWTARGETDEV) (* ; "NEW-DEVICE is a pseudo host") + (SETQ NEWTARGETNAME (EXPAND.PH NEW-NAME NEW-DEVICE))) + (SETQ RESULT (APPLY* (FETCH (FDEV RENAMEFILE) OF OLDTARGETDEV) + OLDTARGETDEV + (EXPAND.PH OLD-NAME OLD-DEVICE) + (OR NEWTARGETDEV NEW-DEVICE) + NEWTARGETNAME)) + (CL:WHEN (AND RESULT (NEQ NEWTARGETDEV NEW-DEVICE)) + (SETQ RESULT (CONTRACT.PH RESULT NEW-DEVICE))) + RESULT]) +) + +(PSEUDOHOST 'LI LOGINHOST/DIR) +(DECLARE%: EVAL@COMPILE DONTCOPY +(DECLARE%: EVAL@COMPILE + +(ACCESSFNS PHDEVICE [(PREFIX (CAR (FETCH (FDEV FDEV2) OF DATUM))) + (TARGETDEV (FETCH (FDEV FDEV1) OF DATUM) + (REPLACE (FDEV FDEV1) OF DATUM WITH NEWVALUE)) + (CONNECTOR (CDR (FETCH (FDEV FDEV2) OF DATUM] + (TYPE? (FETCH (PHDEVICE PREFIX) OF DATUM))) + +(RECORD PHGENFILESTATE (PHDEVICE . TARGETGENFILESTATE)) +) + +(DECLARE%: EVAL@COMPILE + +(PUTPROPS PSEUDOHOST.NAME MACRO + [TAIL (LET [(OPNAME (CAR TAIL)) + (ARGS (CADR TAIL)) + (DEV (OR (CADDR TAIL) + (CAR (LAST (CADR TAIL] + + (* ;; + "Assumes that the name is (CAR ARGS), the device is the last or args if not specified separately") + + `(CONTRACT.PH [APPLY* (FETCH (FDEV ,OPNAME) OF (FETCH (PHDEVICE TARGETDEV) + OF ,DEV)) + (EXPAND.PH ,(CAR ARGS) + ,DEV) + ,@(SUBST `(FETCH (PHDEVICE TARGETDEV) OF ,DEV) + DEV + (CDR ARGS] + ,DEV]) + +(PUTPROPS PSEUDOHOST.TARGETVAL MACRO + [TAIL (LET [(OPNAME (CAR TAIL)) + (ARGS (CADR TAIL)) + (DEV (OR (CADDR TAIL) + (CAR (LAST (CADR TAIL] + + (* ;; "Assumes that the name is (CAR ARGS), the device is the last or args if not specified separately. Unlike PSEUDOHOST.OP, this returns the target value, doesn't assume it is a name to be contracted.") + + `(APPLY* (FETCH (FDEV ,OPNAME) OF (FETCH (PHDEVICE TARGETDEV) + OF ,DEV)) + (EXPAND.PH ,(CAR ARGS) + ,DEV) + ,@(SUBST `(FETCH (PHDEVICE TARGETDEV) OF ,DEV) + DEV + (CDR ARGS]) +) + + +(CL:UNLESS (GETP 'EXPORTS.ALL 'FILE) + (LOAD 'EXPORTS.ALL)) +) +(DECLARE%: DONTCOPY + (FILEMAP (NIL (1205 7096 (PSEUDOHOST 1215 . 5418) (PSEUDOHOSTP 5420 . 5770) (PSEUDOHOSTS 5772 . 6129) +(TARGETHOST 6131 . 6405) (TRUEFILENAME 6407 . 7094)) (7124 13330 (EXPAND.PH 7134 . 8189) (CONTRACT.PH +8191 . 10010) (SLASHIT 10012 . 11580) (UNSLASHIT 11582 . 13328)) (13331 20121 (OPENFILE.PH 13341 . +13902) (GETFILENAME.PH 13904 . 14193) (DIRECTORYNAMEP.PH 14195 . 14819) (CLOSEFILE.PH 14821 . 15175) ( +REOPENFILE.PH 15177 . 15742) (DELETEFILE.PH 15744 . 16028) (OPENP.PH 16030 . 16206) (UNREGISTERFILE.PH + 16208 . 16513) (REGISTERFILE.PH 16515 . 16816) (GENERATEFILES.PH 16818 . 17858) (GETFILEINFO.PH 17860 + . 18162) (SETFILEINFO.PH 18164 . 18363) (NEXTFILEFN.PH 18365 . 18907) (FILEINFOFN.PH 18909 . 19180) ( +RENAMEFILE.PH 19182 . 20119))))) +STOP diff --git a/lispusers/PSEUDOHOSTS.LCOM b/lispusers/PSEUDOHOSTS.LCOM new file mode 100644 index 0000000000000000000000000000000000000000..6bf39e065921f84ea1d8173c848494613c527be7 GIT binary patch literal 7525 zcmd5>-ESk+6}O$REbfv`masw*4Yx)`_NqxdbW^X?^+l5+WW#{U(&F*@K?QF9I zi@#=g^_%D0yX)6?7q-@}b=S5R?42uX-G!^`o$mUpnc3XJ)mLXkXQ8{fd+imzwCR~` z!>Ku5%bR^xQA#OnnD1|>X67@c`CJJbT)w^@Y`Om9Yu9(bJI}UvZftCBzsxovLbYw% zEd1Ts+1Ui^tlfZ!!|%+d=hN9l>c4B6e{h;HRn02}HeadfjYZR&X*n!;QFlES580sN zEPE+7-*nB3meclT3}A3X`b>sH@PJHSOoaqs^F}eAY_be%>F%Q0G9X9AWKE{Z0YVC0 zh4~_)lV+E=f4S|Z@GDEqSFIIhVU~ZV%5v-yIhJ@Ow2c1cp=czgbw+;E)Bm8wqL*Vm zEqXcfhW1DVfBfTeL_av!;mzOOj=nuH9?{xyniZc{;yrDH_aD0*ef?#c;JuHY;_d#2 zev0PAD`RiySHI-TcKTmP=)9xz@ppOq&Hgkbo6tsuT&uU_mOZ_{A%F7=ynp!NQb#my z^>jY|OVNE#^zg1FK78;f-(ZPv`HA*J5~j{O9c?n!>(nRJp5Bq7cIOV?<*#{@e@=bc zu_v=VvC-t1-{0Ge6H#`%j7r> zeHq`#l$dAhUd?JDjB>2q2zqISwPz}vyGnUR4o2UoTBdC6V6$M)b8!PENBYO3BWW~(T?)lP?9dadRxaP8R z(PX*Ikg8lwXxSGRF<10eQ!{M2uD6_JP*zqgF;^;So3qUt%c^PSnJtopXrB*3R+w^N zD6L|sVY;9c8uw^j2GF?XqU9ky&>$a!)!L0CqcEP+G#gF6B%f!7X`A9rd?Z)Ei)cac z8o*hx9glCumq0zka?MK1aaT!S@v2PPmz2i%LRH~g1#e0h*?E?M{Bv-ZB71#wqzcz+ ztv1c4Ux#lHET9@y$pcOo-jXgbWFw}O6u~`8I?c+CvC2w0K2egKR4DR!7?owSIhNSm zrHsPX*tOmDS2{ZzJG(a$OwD1Y-KaO5=Npm)`L_~G$rV{*fu1T$%;A|$i>F#($-K(4 z1(r{z!t~no`85smT@1)E#UkH}Mj}ydv-2&Yfr)6O*4h8|32J|){+S+kPHQ#M&qg<< zrVw$6vVmYB>p_!Dj*)R-DDhNE{E3;cAf7KsmJ4!}oFiqBbEG|?kJd&GMy>JarLZ*n zPuZdylTR+xCrbyX>Kjup+^xk{_WoLb=HA}FA`Q!iOhN_*q=ak;6_OEv(UZ$2@(oWF zJO}xS1Gbrl{!ziccg~8Z6h;aGYbeJC)Ihvr8&HSXxER{lZF3jp5h&B2LRJxpFC9cR zhl_j?A}z!q(gc%I?N4e#l9M0HM*J5-&J|Aet70}Ay;ZX~eU8^4G9t!YY3dDwd>*cI z6i$}OvP-&Q%z~vFh#S+GMF6oPQI)ALH=z-DOPDk#2g#^nnwz!1L!g@1t|BuN)lupe zJ?Ms%UL#P*@T4X8Cl+}Vn#MHlgZtCS(?XRvC2Ohk!H9M_(tBIyYd#3F9IV4rgvK>q zz4M%AZGFz$D~t3nf8RlR`&DoAC%ujLYTX!L^Re#RtR^f5h(UZlT?1~f zU51`kW08TcDmBa~tWXFI=ebEp&m)ON#)<;s6yRNa^z>? z!Hs>77a8*HG4b7lhxwBiQsb2Il^l{Q65u(WC<9;$;T);Jzhv4*qLB#}*zQ~NP;jBUl0f8d|K!h}^OzIL?N)~7lD=P#VE8?*L?0kVF zZUt5WNEx_26}fy8ryc?kg0}#SA1Ja(fnpO_=zBa^RtT|^h?0=IAB_BH>+^~4#A*}z z!@ysu7xZ6Q2anXY4)UW*7KP?|T+Sr)-!Kd}Dzkjm#PUD$B?)_8Ss%?G2-zh3gju<6K zQSYE!>zlr$`s2m$Z~>Z%(hBLmzZw=7Z=qt&V~EOdaYvBzLMj#K+|P;yLLn;xr(Zuw z^B1|934%c&BkRFbkFZS)xCN6(Z9P3duN?7 zA~k?SDBbD-CTGkUduhA}h{ghlZh!eIVf2sVFoK)<7@^|oTm65BQMicfCk>u);P0pc zZ9@{T1z36TSqLDfRWm`yxOT7*NGS81MYI&AS1P6_B1I<8CQ`}?L-4yQ9%CqZG=n?3 zUat6aX7@zx^w^n+Xw>4%#OG%x#lp#xqHj#bEqFKR9)=5OS?Lh@F7g zF~1BMu<|$;xEq6A$3@{Oi(kqp(rf~Hh?9yB9#_8F)5%pHoTtN^|4%)A@IV)!;5$yJ zCY&P(e4h{yoIUC+9EdZ4uVhiBeRX`|6vz?kBSl?~Q*i1G{2DViA>WX%%BW%_hjd##?5jBAf0YG>&*EQq&*^Wl=aH)d zxhaUg*|MAlF}ey(JL@2V{OvMNNLRu2ZWWZ=c8$V8jhK;c`42EYc z9Gbk2rF=oM)9ZsmfUMw}UfZTSaoiS~&kKENA-75}0wB3PP&|nxG(cq&R?P6_6i(C$ zAjc(`ZTNF(-Vt-K)P;vaG3D19m5HZEEq)5WRS`^gPu>|#eOl8+m{|uS<)!YZeR}N0 z&Yja%`SAUYEJ4Vm1%5yXYA77Zf}mrlk%A7TbN}4sU#Up?3RNaa9DG}?Rs5#WL}3UM z^?&Q(zjMTsZd1Q-VR)P+ljqp8&$2}GmCN1DD{OuH#`Vqh-9(BdtDv3!TSCodsO^P+ zs))Bj*E@KFc(b*AWBvN}S~qxUpjp_Zg0pLIYLOy@E9Bt<@n|_VP}~d_9fK)1NOVWD z44iN9lJ*Ea50Tmsp$tawV2BJlHdJilKY)rQFSH#5vu&lA?JQaix}uwdmMN?>%!;kM zCVq)CK~EYXjqqRw@_fZ7@}VEW_6nuib2wp1hpOA@W;aIQv46Ucm=!ptB&f+&$Isl D7~Q4U literal 0 HcmV?d00001 diff --git a/lispusers/PSEUDOHOSTS.TEDIT b/lispusers/PSEUDOHOSTS.TEDIT new file mode 100644 index 0000000000000000000000000000000000000000..8bf8c4e7b14f70821d16188913cfca55a4cfe817 GIT binary patch literal 5636 zcmeHJ>vG%H5e8)?jp=%NnM|5ar|!1RBxEbIlA_3V$DaGcqkzT z0S+#dnM__FuhBn!hCV?arVr6?_Yfc?+j88=Pjf~juxBsd?tZ&R12u`%^5$@4j*pxZ zXXK4`o45Cxw|APiYchU?@X?Zp+$5&Q{yg&Irgt7@G)aPDrsA9~{EUKB`MH`<7}Mu| zT=?mdcDHwTJI!X7=9wxc$$66H6i#3ePD7PZey%7@lAMw$`7{k9McFdT)eI+oPU?A> zf!;aRvqAlRQLDV)X=KotkcT%~@_ zR>)};9LO2c3$bYKr+F9@kuK?BVpo2ww4E;)bp68kg7NF^1? zjisD>s^Bm`XPXfDMM(f4KmkLa5aSGa)r!%fUXr31{%jtpEufpvlT2y9>~i6!p?`|n z4a}py`Si$gDM;en4`W?niAB>inb9{#qsQNJ+!xXml$DtuMKln0lnr4#8MRdBtfRd= z9A_%c4xR}c4*JL;I+%&cK^w)lri2bLkQmhhDc@9FSqC- zDWVB+eUWQIr=W_Os#L{+0wtPYBR-PQHBhpoNCTA}XwRJ{V4+IH)K$|k1}|!XGIW%agaw#j`0n`e*5q$9HHpk51#pF zibC!$PZPqe$3@~y)FMP0y60$4av|{{kkFcWA!h@E&-^%?gR84q%z02jdYK4C(*l^7 zZR-(V)q=+)Ru}c)7noR>NbiFL*&s<_z7R;uQ43A%i5_EJDq2q~^Y5?JY}EqtvZ0}C z_N*uEoB!yoApNt+L}zC!?p2&u&s9*!u-3hN!mX@G-v%(yHd8qjbLq0Qwxw&?CRsi* zl$z^k9XM5Fnwx8Gy@dB2YI#64E#RM%W-r)xwdS*%yLTCSt#w}&Sa;YL3sg;ZknA?h zdO-f^X{r`7_MJ8lORYF)7ltVUF5x0O73{JkQQbwD6kuh%DEG!G){u{aPh~tfWJOlp zPwwhz8)}_ei2~?Ky7R*3Q-#&3N9N|k(Y|B1QcIA zpGRR3YQs+ROWq~xI*u4ml=u@h*}@E?U|}BmQTVmY(WOT9EsZZ*#!0-K(G)c7JI9vI znf!$pDn`88<6L`TX_TDdX-#w{M14(7>O0`#oUgY_`_PYZ6QTa;+6OMn8pB7IhQn2P zk*;=n>xD{YGJPOuP^4IrymrbJx29y)skIi+j)AD!b2}f^MaN z&|cR)Ha$_`uUAH{^Fgz|cK=omUmp=m$8*QnGJVtT4ou>QR|YNbYgXb8^V-kTLZOVj ze78tt8QURn&kM$X~qn^ zQ0Sjb3WEU`ng)MvwE7nIWveyp9-C5TJPl2EWc}TwzREFW)N}flW7$22T3xsM$U1D( z2<7%H`Y7qcfK_q zFfh|CBacU>D`jDJj=ZOUi>Ef~2POV@l$7M;<-TJyjXmRzai{UU(SW3JV-sJ-zvb|nuRT74%}@D9Y#QIQ{dJ$x zM#sT-Y)1diVn+d7~BC(i3_I-D$O@C*EGZrtFvYd#(0JL9{?edAr|{BUh{xVeFz zT>JT)Pk}@}SGsYFx9)128@Fn!Tx-ANd(+r7J~W!1H84l6Gw9mJM_OycFg`He!+klh z>~7z9ud;pLcvoL_!Uu?*HN{v^9`Ed+6LBXecyCE50#aV|S%98yGdujMO?5{Lr-v1nbQX=-u^!f8u!KHMe z(KstLI52m^_;o3Hr<8O{36+uurG$fs)yJiTUpbj7(x;^gJFn2ObIF;TCJ%i4d;Ez? zg~lo+@ACueTyn!N|K*di_x$@I3;0BeRX_OypRnLJ`~a18{-VZ4KjR~Qt8$Yg{;F`Y zp6FCo?NY*SSt^qz$18!9lLfa}l|B54A6O#p`0JOY$ z)%FexBpAL~<6)^$WhRLEOCDJFgHopq_*)j#y~w&|{cF7Z>Z+IDUG*Xjz7)A)Z-qqy j@LR>rR_V9W`KXkXc%@<`URHadgschS&3_sB*Z=t+OCtBB literal 0 HcmV?d00001 diff --git a/lispusers/REGIONMANAGER b/lispusers/REGIONMANAGER index e411b43c..3d68fac5 100644 --- a/lispusers/REGIONMANAGER +++ b/lispusers/REGIONMANAGER @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 2-Jan-2022 16:01:26"  -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>REGIONMANAGER.;99 31663 +(FILECREATED "27-Jan-2022 13:24:29"  +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>REGIONMANAGER.;106 34264 - :CHANGES-TO (FNS SET-TYPED-REGIONS \RELCREATEREGION.REF \RELCREATEREGION.SIZE) + :CHANGES-TO (FNS RELCREATEREGION \RELCREATEREGION.SIZE RELGETREGION) - :PREVIOUS-DATE " 1-Jan-2022 23:14:42" -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>REGIONMANAGER.;95) + :PREVIOUS-DATE "25-Jan-2022 15:38:10" +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>REGIONMANAGER.;105) (PRETTYCOMPRINT REGIONMANAGERCOMS) @@ -30,7 +30,7 @@ (* ;; "Relative regions") - (COMS (FNS RELCREATEREGION RELGETREGION) + (COMS (FNS RELCREATEREGION RELGETREGION RELCREATEPOSITION) (FNS \RELCREATEREGION.REF \RELCREATEREGION.SIZE)) (* ;; "Composite application construction") @@ -250,7 +250,11 @@ (DEFINEQ (RELCREATEREGION - [LAMBDA (WIDTH HEIGHT CORNERX CORNERY REFX REFY ONSCREEN) (* ; "Edited 30-Dec-2021 20:54 by rmk") + [LAMBDA (WIDTH HEIGHT CORNERX CORNERY REFX REFY ONSCREEN) (* ; "Edited 27-Jan-2022 13:23 by rmk") + (* ; "Edited 25-Jan-2022 15:29 by rmk") + (* ; "Edited 23-Jan-2022 21:18 by rmk") + (* ; "Edited 12-Jan-2022 17:50 by rmk") + (* ; "Edited 30-Dec-2021 20:54 by rmk") (* ; "Edited 27-Dec-2021 15:54 by rmk") (* ;; "The region is oriented so that he REFX and REFY are at the corner named by CORNERX/Y. ") @@ -274,99 +278,129 @@ (* ;; "") - (* ;; "Resolve the width and height, if based on a region or window ") + (* ;; "The arguments can be given as a list to be spread out, so that region relative region specifications can be passed through intermediate functions. The test here is not very tight, if it is incorrect the recursive call will fail.") - (SETQ WIDTH (\RELCREATEREGION.SIZE WIDTH 'X)) - (SETQ HEIGHT (\RELCREATEREGION.SIZE HEIGHT 'Y)) + (IF (AND (LISTP WIDTH) + (NOT (REGIONP WIDTH)) + (NULL HEIGHT) + (IGREATERP (LENGTH WIDTH) + 3)) + THEN + (* ;; "If less than 3, presumably a relative width") - (* ;; "Resolve the corner") + (APPLY (FUNCTION RELCREATEREGION) + WIDTH) + ELSE + (* ;; "Resolve the width and height, if based on a region or window ") - (CL:UNLESS CORNERX - (SETQ CORNERX 'LEFT)) - (CL:UNLESS CORNERY - (SETQ CORNERY 'BOTTOM)) - (CL:WHEN (AND (LISTP CORNERX) - (NULL CORNERY)) - (SETQ CORNERY (CADR CORNERX)) - (SETQ CORNERX (CAR CORNERX))) + (SETQ WIDTH (\RELCREATEREGION.SIZE WIDTH 'X)) + (SETQ HEIGHT (\RELCREATEREGION.SIZE HEIGHT 'Y)) - (* ;; "Resolve the reference point") + (* ;; "Resolve the corner") - [IF (AND (POSITIONP REFX) - (NULL REFY)) - THEN (SETQ REFY (FETCH (POSITION YCOORD) OF REFX)) - (SETQ REFX (FETCH (POSITION XCOORD) OF REFX)) - ELSE (GETMOUSESTATE) - (SETQ REFX (\RELCREATEREGION.REF REFX 'X)) - (SETQ REFY (\RELCREATEREGION.REF REFY 'Y] + (CL:UNLESS CORNERX + (SETQ CORNERX 'LEFT)) + (CL:UNLESS CORNERY + (SETQ CORNERY 'BOTTOM)) + (CL:WHEN (AND (LISTP CORNERX) + (NULL CORNERY)) + (SETQ CORNERY (CADR CORNERX)) + (SETQ CORNERX (CAR CORNERX))) - (* ;; "Align the new-region corner with the reference point") + (* ;; "Resolve the reference point") - (LET* ((LEFT REFX) - (BOTTOM REFY) - (RIGHT (IPLUS LEFT WIDTH)) - (TOP (IPLUS BOTTOM HEIGHT))) - (CL:WHEN (EQ 'RIGHT CORNERX) - (SETQ RIGHT LEFT) - (SETQ LEFT (IDIFFERENCE LEFT WIDTH))) - (CL:WHEN (EQ 'TOP CORNERY) - (SETQ TOP BOTTOM) - (SETQ BOTTOM (IDIFFERENCE BOTTOM HEIGHT))) - (CL:WHEN ONSCREEN (* ; "Keep the region on the screen. ") - (CL:WHEN (ILESSP LEFT 0) - (ADD WIDTH LEFT) - (SETQ LEFT 0)) - (CL:WHEN (ILESSP BOTTOM 0) - (ADD HEIGHT BOTTOM) - (SETQ BOTTOM 0)) - (CL:WHEN (IGREATERP RIGHT SCREENWIDTH) - (ADD WIDTH (IDIFFERENCE SCREENWIDTH RIGHT))) - (CL:WHEN (IGREATERP TOP SCREENHEIGHT) - (ADD HEIGHT (IDIFFERENCE SCREENHEIGHT TOP)))) - (CREATEREGION LEFT BOTTOM WIDTH HEIGHT]) + [IF (AND (POSITIONP REFX) + (NULL REFY)) + THEN (SETQ REFY (FETCH (POSITION YCOORD) OF REFX)) + (SETQ REFX (FETCH (POSITION XCOORD) OF REFX)) + ELSE (GETMOUSESTATE) + (SETQ REFX (\RELCREATEREGION.REF REFX 'X)) + (SETQ REFY (\RELCREATEREGION.REF REFY 'Y] + + (* ;; "Align the new-region corner with the reference point") + + (LET* ((LEFT REFX) + (BOTTOM REFY) + (RIGHT (IPLUS LEFT WIDTH)) + (TOP (IPLUS BOTTOM HEIGHT))) + (CL:WHEN (EQ 'RIGHT CORNERX) + (SETQ RIGHT LEFT) + (SETQ LEFT (IDIFFERENCE LEFT WIDTH))) + (CL:WHEN (EQ 'TOP CORNERY) + (SETQ TOP BOTTOM) + (SETQ BOTTOM (IDIFFERENCE BOTTOM HEIGHT))) + (CL:WHEN ONSCREEN (* ; "Keep the region on the screen. Not clear whether we should keep the width and height and just move the left and bottom. Here we allow some shrinkage") + (CL:WHEN (ILESSP LEFT 0) + (ADD WIDTH (IMIN 100 LEFT)) + (SETQ LEFT 0)) + (CL:WHEN (ILESSP BOTTOM 0) + (ADD HEIGHT (IMIN 100 BOTTOM)) + (SETQ BOTTOM 0)) + (CL:WHEN (IGREATERP RIGHT SCREENWIDTH) + (ADD WIDTH (IDIFFERENCE SCREENWIDTH RIGHT))) + (CL:WHEN (IGREATERP TOP SCREENHEIGHT) + (ADD HEIGHT (IDIFFERENCE SCREENHEIGHT TOP)))) + (CREATEREGION LEFT BOTTOM WIDTH HEIGHT]) (RELGETREGION - [LAMBDA (WIDTH HEIGHT CORNERX CORNERY REFX REFY MINSIZE) (* ; "Edited 28-Dec-2021 23:13 by rmk") + [LAMBDA (WIDTH HEIGHT CORNERX CORNERY REFX REFY MINSIZE) (* ; "Edited 27-Jan-2022 13:24 by rmk") + (* ; "Edited 25-Jan-2022 15:30 by rmk") + (* ; "Edited 23-Jan-2022 21:20 by rmk") + (* ; "Edited 28-Dec-2021 23:13 by rmk") (* ; "Edited 10-Dec-2021 10:15 by rmk") (* ;; "Prompts for a relative region as created by RELCREATEREGION. Initially the anchored corner is fixed and the cursor is moved to the diagonally opposite corner. If MINSIZE, the WIDTH and HEIGHT are taken to be the minimums that are acceptable, modulo the fact that the opposite corner is guaranteed to be visibleand, the size of the ghost region can only grow. If not MINSIZE, we also allow the user to shrink the ghost region.") - (CL:WHEN (AND (LISTP CORNERX) - (NULL CORNERY)) - (SETQ CORNERY (CADR CORNERX)) - (SETQ CORNERX (CAR CORNERX))) - (CL:UNLESS CORNERX - (SETQ CORNERX 'LEFT)) - (CL:UNLESS CORNERY - (SETQ CORNERY 'BOTTOM)) - (LET* ((REGION (OR (REGIONP WIDTH) - (RELCREATEREGION WIDTH HEIGHT CORNERX CORNERY REFX REFY T))) - (BASEX (FETCH (REGION LEFT) OF REGION)) - (BASEY (FETCH (REGION BOTTOM) OF REGION)) - (RWIDTH (FETCH (REGION WIDTH) OF REGION)) - (RHEIGHT (FETCH (REGION HEIGHT) OF REGION)) - (OPPX (IPLUS BASEX RWIDTH)) - (OPPY (IPLUS BASEY RHEIGHT))) + (COND + ((AND (LISTP WIDTH) + (NOT (REGIONP WIDTH)) + (NULL HEIGHT) + (IGREATERP (LENGTH WIDTH) + 3)) + (APPLY (FUNCTION RELGETREGION) + WIDTH)) + (T (CL:WHEN (AND (LISTP CORNERX) + (NULL CORNERY)) + (SETQ CORNERY (CADR CORNERX)) + (SETQ CORNERX (CAR CORNERX))) + (CL:UNLESS CORNERX + (SETQ CORNERX 'LEFT)) + (CL:UNLESS CORNERY + (SETQ CORNERY 'BOTTOM)) + (LET* ((REGION (OR (REGIONP WIDTH) + (RELCREATEREGION WIDTH HEIGHT CORNERX CORNERY REFX REFY T))) + (BASEX (FETCH (REGION LEFT) OF REGION)) + (BASEY (FETCH (REGION BOTTOM) OF REGION)) + (RWIDTH (FETCH (REGION WIDTH) OF REGION)) + (RHEIGHT (FETCH (REGION HEIGHT) OF REGION)) + (OPPX (IPLUS BASEX RWIDTH)) + (OPPY (IPLUS BASEY RHEIGHT))) - (* ;; "Default parameters assume the anchor is (LEFT BOTTOM)") + (* ;; "Default parameters assume the anchor is (LEFT BOTTOM)") - (CL:WHEN (EQ 'RIGHT CORNERX) - (SWAP BASEX OPPX)) - (CL:WHEN (EQ 'TOP CORNERY) - (SWAP BASEY OPPY)) - (\CURSORPOSITION OPPX OPPY) - (CL:UNLESS MINSIZE (* ; "No minimum size constraint") - (SETQ RWIDTH NIL) - (SETQ RHEIGHT NIL)) - (GETREGION RWIDTH RHEIGHT REGION NIL NIL (LIST BASEX BASEY OPPX OPPY]) + (CL:WHEN (EQ 'RIGHT CORNERX) + (SWAP BASEX OPPX)) + (CL:WHEN (EQ 'TOP CORNERY) + (SWAP BASEY OPPY)) + (\CURSORPOSITION OPPX OPPY) + (CL:UNLESS MINSIZE (* ; "No minimum size constraint") + (SETQ RWIDTH NIL) + (SETQ RHEIGHT NIL)) + (GETREGION RWIDTH RHEIGHT REGION NIL NIL (LIST BASEX BASEY OPPX OPPY]) + +(RELCREATEPOSITION + [LAMBDA (REFX REFY) (* ; "Edited 23-Jan-2022 17:08 by rmk") + (CREATEPOSITION (\RELCREATEREGION.REF REFX 'X) + (\RELCREATEREGION.REF REFY 'Y]) ) (DEFINEQ (\RELCREATEREGION.REF - [LAMBDA (REF WHICH) (* ; "Edited 2-Jan-2022 11:01 by rmk") + [LAMBDA (REF WHICH) (* ; "Edited 23-Jan-2022 20:20 by rmk") + (* ; "Edited 2-Jan-2022 11:01 by rmk") (* ;; "REF can be NIL, an absolute screen position, the atom SCREEN, or a list of (anchor fraction adjustment) where anchor can be a region, window, or the atom SCREEN, fraction can be a number or atoms LEFT/RIGHT/BOTTOM/TOP as apropriate.") - (* ; "Edited 30-Dec-2021 17:49 by rmk") + (* ; "Edited 30-Dec-2021 17:49 by rmk") (LET (ANCHOR VAL SIZE FRACTION SPEC (BASE 0)) (* ;; "Would be nice if the screen had a region") @@ -386,7 +420,8 @@ ELSEIF [AND (LISTP REF) (SETQ ANCHOR (OR (REGIONP (CAR REF)) (AND (WINDOWP (CAR REF)) - (WINDOWREGION (CAR REF))) + (WINDOWPROP (CAR REF) + 'REGION)) (AND (EQ (CAR REF) 'SCREEN) 'SCREEN] @@ -417,7 +452,7 @@ ELSE (\ILLEGAL.ARG REF]) (\RELCREATEREGION.SIZE - [LAMBDA (PARAM WHICH) (* ; "Edited 2-Jan-2022 11:00 by rmk") + [LAMBDA (PARAM WHICH) (* ; "Edited 2-Jan-2022 11:00 by rmk") (* ; "Edited 30-Dec-2021 17:51 by rmk") (* ;; @@ -591,8 +626,9 @@ ) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1602 3789 (SET-TYPED-REGIONS 1612 . 3787)) (3790 10791 (RM-CREATEW 3800 . 6307) ( -RM-CLOSEW 6309 . 7710) (RM-GETREGION 7712 . 10298) (CLOSE-TYPED-W 10300 . 10789)) (11707 16778 ( -RELCREATEREGION 11717 . 14876) (RELGETREGION 14878 . 16776)) (16779 21898 (\RELCREATEREGION.REF 16789 - . 19646) (\RELCREATEREGION.SIZE 19648 . 21896)) (21951 31293 (RM-ATTACHWINDOW 21961 . 31291))))) + (FILEMAP (NIL (1612 3799 (SET-TYPED-REGIONS 1622 . 3797)) (3800 10801 (RM-CREATEW 3810 . 6317) ( +RM-CLOSEW 6319 . 7720) (RM-GETREGION 7722 . 10308) (CLOSE-TYPED-W 10310 . 10799)) (11717 19196 ( +RELCREATEREGION 11727 . 16350) (RELGETREGION 16352 . 18959) (RELCREATEPOSITION 18961 . 19194)) (19197 +24499 (\RELCREATEREGION.REF 19207 . 22239) (\RELCREATEREGION.SIZE 22241 . 24497)) (24552 33894 ( +RM-ATTACHWINDOW 24562 . 33892))))) STOP diff --git a/lispusers/REGIONMANAGER.LCOM b/lispusers/REGIONMANAGER.LCOM index c2f03a9ee7e171392455d3c4571c0fbe3bde99bc..13abab87d5441ec8c38ab0163f58c4217841ddd6 100644 GIT binary patch delta 1276 zcmZ`(O=}ZT6wRcywW&>8ZEe$5ytIWjNOj(uH=hb7Z6?XcbS6wDwiOpzieg)e{(|62 z5ESd%>7w9LT&O`16th(KE<`8@g8MAox$w?RK5Wq}k~jC`-E+=8lkfVs3y)StsJd|J z`pyCsDFq@Klo?dt-CCOWr8g&fYpQE~@9kqt>Rh!~8D6R~zXzTbOBnCXtidNUhcuV?yV z_^C~1YvY;lxZTxwdNYV+62bQnFDIVOc$>w>US@lv*w`)J-QM`J9;<4Ix$e`qwEg#vIKoS4Ln5q9s z;LX`m$zB60f^9klzX&?&6Np#B9Z*$*GJ-OlqG=VXMIYBD{}l-Wa;s#;%3(WYt%B&8 zXgc_A35cqIXBDu6Fa~Sr8xdAP)nU=~eRmlY9RcKhkY!9Via8n}`Fo#&!`)*qF4lVk z`MchXE#eATeW`YCF)pn4)E9;I?w7OCN`7W*KiVsK{q?|3jt|_cqSkE-08uDhU8;Cx z*K27Bx^`%|1De!Q24tlv8*9rJqHXCGtS%%isZG)cjBHNK)gDhc@joW7JqQ2* delta 944 zcmZva&rj4q6o9u2flyI2sDvz#_-#MK}mbjA&wF z2;96%=71*;CLZ8QOpF)ef8fEBiAL|ng!m6Q-L@b?FVmTMGw*xfysy(gj92Z8fD3oJ zs|74$3`jR+WMX}5r890Ad5{1dZDPgLbW>5czK?B$gcfMWCw3tqb;oOl@L(0BTFZ6e z-y_9hQG&(p)1}4Ju2N+wFHY7RmsA5%p~U7vr@%-czOci)>(i~Zr6+5*R=STLvQ0t1 zX&9g&U01-YHY&|J2@BMN$r@)7PvEi2$R+kuxO_birXP@dj@JqcHqUv23#q1x*(1Rb zjJ;>sZ-WDw-~E})AX^vTj#|r&gYB8dmxav!@`q*TV7uZl>&(=sqCs3iECUe2QNlhj z%F%cY$~x2uo#jbMNTaNJ34AYfC|BnLRyf*N7ReFe23LZy3?aXfG#kXJHz;6)|67pL zh_++X1|TC1Nah*_>iK{a1A^WaNG?GK3pxU6&Chff1#b#MK`^Pz!!uT9gQ6!Uz31E!`xWLB=meqEUmMD{Lso1MEl P%nounLEIajXlDNc2vPAU diff --git a/lispusers/REGIONMANAGER.TEDIT b/lispusers/REGIONMANAGER.TEDIT index 70961946..916124ff 100644 --- a/lispusers/REGIONMANAGER.TEDIT +++ b/lispusers/REGIONMANAGER.TEDIT @@ -37,10 +37,12 @@ NIL: LASTMOUSEX/LASTMOUSEY natural number: an absolute screen coordinate (anchor fraction adjustment) or just region/window/SCREEN: the quantity determined relative to the size of anchor (as above) is added to the anchors left/bottom produce the REFX/REFY coordinate. In this case, fractions specified as LEFT/BOTTOM/NIL are interpreted as 0 and RIGHT/TOP are interpreted as 1. For example, a specification ( .4 -2) for REFY will produce a coordinate 2 points below the level that is 40% of the distance between the bottom and top of the window's region. For convenience, if REFX is a position and REFY is NIL, then the XCOORD and YCOORD of REFX are taken as absolute values for REFX and REFY. +Also for convenience, if WIDTH is a potentially a list of RELCREATEREGION arguments, then the elements of that list are spread out in a recursive call. (RELGETREGION WIDTH HEIGHT CORNERX CORNERY REFX REFY MINSIZE) [Function] Calls GETREGION with an initial ghost region as created by RELCREATEREGION. CORNERX and CORNERY determine the ghost region's fixed corner, and the cursor starts at the region's diagonally opposite corner. If MINSIZE is true, then WIDTH and HEIGHT are taken as the minimum sizes of the region, except for adjustments that may be needed to ensure that all corners of the ghost region are initially visible on the screen. - +(RELCREATEPOSITION REFX REFY) [Function] +Creates a position with X and Y coordinates specified by REFX and REFY references as above. Constellation regions Applications are often set up as a constellation of windows, a central or primary window surrounded by some number of satellites for menus, headers, prompts, and secondary outputs. The main panel of a file browser, for example, displays the list of files, but above it are carefully arranged windows for the column headers, summary information, and prompts, and off to the side is the menu of file browser commands. FILEBROWSER interprets the screen region that the user sweeps out for a new browser as the region for the whole constellation,the smallest region that will enclose the central window and all of its satellites. Similarly, the screen region given to TEDIT and SEDIT is divided between the prompt window and the central editing window, again so that the whole constellation (a pair in these cases) fit within the provided region. Each of these applications is constructed by anticipating the subregions that the satellite windows will occupy after they are attached, decreasing the constellation region by their estimated (using WIDTHIFWINDOW HEIGHTIFWINDOW) or actual sizes, and then using remainder as the region for the central window. @@ -56,4 +58,4 @@ TIMESROMAN$TERMINALMODERN MODERN  HRULE.GETFNMODERN   HRULE.GETFNMODERN   (}/ [ ChT  ?   ; 3o) MA &MmJS- -j /3t2C  "= , l S~ - 4!U(N!z \ No newline at end of file +j /3t2C  "O= , l.9 S~ - 4!U)o-z \ No newline at end of file diff --git a/lispusers/TEDIT-PF-SEE b/lispusers/TEDIT-PF-SEE index 1d2819e7..e1eec143 100644 --- a/lispusers/TEDIT-PF-SEE +++ b/lispusers/TEDIT-PF-SEE @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 2-Jan-2022 22:03:27"  -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>TEDIT-PF-SEE.;104 6489 +(FILECREATED "12-Jan-2022 13:16:00"  +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>TEDIT-PF-SEE.;110 7695 - :CHANGES-TO (VARS TEDIT-PF-SEECOMS) + :CHANGES-TO (FNS PF-TEDIT) - :PREVIOUS-DATE "30-Dec-2021 23:17:58" -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>TEDIT-PF-SEE.;103) + :PREVIOUS-DATE " 2-Jan-2022 22:03:27" +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>TEDIT-PF-SEE.;104) (PRETTYCOMPRINT TEDIT-PF-SEECOMS) @@ -22,7 +22,8 @@ (DEFINEQ (PF-TEDIT - [LAMBDA (FN IFILES REPRINT) (* ; "Edited 30-Dec-2021 23:17 by rmk") + [LAMBDA (FN IFILES REPRINT) (* ; "Edited 12-Jan-2022 13:15 by rmk") + (* ; "Edited 30-Dec-2021 23:17 by rmk") (* ;; "PF* to a read-only TEDIT window. First argument is the function name, second if given is the input file.") @@ -76,13 +77,27 @@ THEN (SETFILEPTR ISTREAM (POP LOC)) (SETQ EXPR (WITH-READER-ENVIRONMENT ENV (READ ISTREAM)) ) - (IF (EQ FN (CAR EXPR)) - THEN (DSPFONT BOLDFONT TSTREAM) - (PRINT FN TSTREAM) - (DSPFONT DEFAULTFONT TSTREAM) - (SETQ EXPR (CADR EXPR)) - (PRINTDEF EXPR 3 NIL NIL NIL TSTREAM) - ELSE (PRINTDEF EXPR NIL NIL NIL NIL TSTREAM)) + (WITH-READER-ENVIRONMENT ENV + (IF (EQ FN (CAR EXPR)) + THEN (DSPFONT BOLDFONT TSTREAM) + (PRINT FN TSTREAM) + (DSPFONT DEFAULTFONT TSTREAM) + (SETQ EXPR (CADR EXPR)) + (PRINTDEF EXPR 3 T NIL NIL TSTREAM) + ELSEIF (EQ FN (CADR EXPR)) + THEN + (* ;; + "Presumably a DEFUN. Print the CAR, boldface the cadr") + + (PRINTOUT TSTREAM "(" .P2 (CAR EXPR) + " " .FONT BOLDFONT .P2 (CADR EXPR) + .FONT DEFAULTFONT " " .P2 + (CADDR EXPR) + T 3) + (PRINTDEF (CDDDR EXPR) + 3 T T NIL TSTREAM) + (PRIN3 ")" TSTREAM) + ELSE (PRINTDEF EXPR 3 NIL NIL NIL TSTREAM))) ELSE (PFCOPYBYTES ISTREAM TSTREAM (POP LOC) (POP LOC))) (TERPRI TSTREAM) @@ -127,5 +142,5 @@ (ADDTOVAR LAMA ) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (956 6010 (PF-TEDIT 966 . 6008))))) + (FILEMAP (NIL (947 7216 (PF-TEDIT 957 . 7214))))) STOP diff --git a/lispusers/TEDIT-PF-SEE.LCOM b/lispusers/TEDIT-PF-SEE.LCOM index 45be05d1a6f87b8125540805fd6664678dbbdb66..ee562f630dec19c96720ae81ea405d715adfdf4e 100644 GIT binary patch delta 1198 zcmZuwO>fgc5RKh55+#&0t)R3}O~Zi%Db?=Uj-7BJA2u~|Y|F8;RFp%N0Ievkgt!+W zaYKS)#1H6!Gld_JbAJPZJGY8E5@S1Q0;*+cX6LUUj z3RnMLW=0j1pyqmd*K~qT zxrJ)sU12M{BYs-cAGjVEpn~Nz(Q06JeB7@c{t|Cl4aaI3j_o5rCE%vra(Lv+;OVYs zCV&FI;d+i60TrkdqGC&g-_zNYz;hQ;`1SGwo(ngpikGh+9Sb*jj?W5wR_x7&@1|A{ z5>7tf%MN%x6Y=MS)cOhj;`&J%|G9LUFZ8>@>DSu>z8K6zlmTBDIah{GR}^~L-Km}J zHRZq^Z0C5T4QuD5lN6&bkUIqg;lWLf<` zOH#%t(;%5)8E76Z1{QyBuR#NP+GbH5+m_K0*Pqj zFsoAV>kVKU+C+w_Ng4xI!6V_MQD6#%WW3{vWHO6@M>cXK_7B3&Qn1V@87U-YqYPCE zv^s9AL8EHpF{TO|M~Q;tU2lQP!q?N=4`rnazUf=oHJRY7gH%X`CSJv&W={a^=$G4-Aa4oZ1lPeV{06clI{~WDMP}!WQKp*jA|G5BLEj#!g!zgg0}~J$KIaeaz>Li}jDZ4p@HHAITVD3>ce; znAkXd)mues6B?jQk;K$=lc=XZ?)#&oMo?^?lAn#e4Kt*#X(upk0FCP%KEP-=&rqzPse)2%>5_6B(Y3SeR?hN-nq-+3iOGE(}q;)gc4V1Sn}k*_1{7SQKWoc%04@wpc` zAs0S{Kun|93s??RU~UwLQEqFn6Z(!DP8c05gjB5wQfF>yM&i}mGvXU8k9jp?<*miF z^Y^^kmAa+DQud*|d3VAuFAr*CUgtIG*SW$svWxQS4zHD@LG5+Q`DPxfserV$owz+B!t89Y(#K9-|2;h6+XR9hx`1Jq1(*P7)Q}SBNqpKoP5Y<3);? zoaKPtf`qbsuOb$MdL<&~9L>(=0|&RoSUu*8UokW>V6iOt+JSZOsnw;7^~57Ug<=@^ w0*GA@%Qvab(6e4;bB&0U4S<(#kKTwAllBeDzE+wgRm(0byW;rLy!Ctj59UtNQ2+n{ diff --git a/lispusers/comparetext b/lispusers/comparetext index b7804763..fd63f9cc 100644 --- a/lispusers/comparetext +++ b/lispusers/comparetext @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "30-Dec-2021 21:22:01"  -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>comparetext.;100 48929 +(FILECREATED "27-Jan-2022 13:20:38"  +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>comparetext.;109 49971 :CHANGES-TO (FNS COMPARETEXT.TEXTOBJ) - :PREVIOUS-DATE "27-Dec-2021 15:56:54" -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>comparetext.;98) + :PREVIOUS-DATE "23-Jan-2022 20:22:06" +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>comparetext.;108) (* ; " @@ -33,11 +33,9 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation. (DEFINEQ (COMPARETEXT - [LAMBDA (FILE1 FILE2 HASH.TYPE REGION FILELABELS) (* ; "Edited 22-Dec-2021 23:49 by rmk") - (* ; "Edited 15-Dec-2021 16:23 by rmk") - (* ; "Edited 13-Dec-2021 12:21 by rmk") - (* ; "Edited 8-Nov-2021 08:44 by rmk:") - (* mjs " 8-Jan-84 21:06") + [LAMBDA (FILE1 FILE2 HASH.TYPE REGION FILELABELS TITLE) (* ; "Edited 12-Jan-2022 16:32 by rmk") + (* ; "Edited 8-Nov-2021 08:44 by rmk") + (* ; "Edited 8-Jan-84 21:06 by mjs") (* ;; "Compares the two files, and produces a graph showing their corresponding chunks. The courseness of the 'chunking' is determined by HASH.TYPE, which may be PARA, LINE, or WORD. HASH.TYPE = NIL defaults to PARA. The file difference graph is displayed at REGION. If REGION = NIL, the user is asked to specify a region. If REGION = T, a standard region is used.") @@ -45,8 +43,10 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation. ((PARA LINE WORD)) (NIL (SETQ HASH.TYPE 'PARA)) (ERROR (CONCAT "Unrecognize HASHTYPE " HASH.TYPE))) - (LET ((FULLFILE1 (FINDFILE FILE1 T)) - (FULLFILE2 (FINDFILE FILE2 T))) + (LET [(FULLFILE1 (OR (GETSTREAM FILE1 'INPUT T) + (FINDFILE FILE1 T))) + (FULLFILE2 (OR (GETSTREAM FILE2 'INPUT T) + (FINDFILE FILE2 T] (CL:UNLESS (AND FULLFILE1 FULLFILE2) (ERROR "Can't find both files" (LIST FILE1 FILE2))) (IMCOMPARE.CHUNKS (create IMCOMPARE.CHUNK @@ -55,17 +55,22 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation. (create IMCOMPARE.CHUNK FILENAME _ FULLFILE2 FILEPTR _ 0) - HASH.TYPE NIL FILELABELS]) + HASH.TYPE REGION FILELABELS TITLE]) (COMPARETEXT.WINDOW - [LAMBDA (GRAPH REGION) (* ; "Edited 27-Dec-2021 13:47 by rmk") - (* ; "Edited 25-Dec-2021 11:40 by rmk") + [LAMBDA (GRAPH REGION TITLE) (* ; "Edited 23-Jan-2022 18:18 by rmk") + (* ; "Edited 12-Jan-2022 10:06 by rmk") (* ; "Edited 22-Dec-2021 15:51 by rmk") (* ;; "Set up the graph WINDOW. If REGION isn't provided we prompt with a region that is wide enough for the graph and high enough for at least an initial segment.") - (LET [WINDOW GRAPHREGION GWIDTH (FILEPREFIX (CAR (GRAPHERPROP GRAPH 'FILELABELS] - [SETQ REGION + (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 HEIGHT (IMIN 200 (IPLUS (FETCH (REGION HEIGHT) OF GRAPHREGION) + (ITIMES 2 (FONTHEIGHT DEFAULTFONT] + (SETQ REGION (if (EQ REGION T) then (create REGION LEFT _ 25 @@ -73,35 +78,38 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation. WIDTH _ 500 HEIGHT _ 150) elseif (REGIONP REGION) - else (CLRPROMPT) - (printout PROMPTWINDOW "Please specify a region for the comparison graph" T) - (SETQ GRAPHREGION (GRAPHREGION GRAPH)) - (SETQ GWIDTH (FETCH (REGION WIDTH) OF GRAPHREGION)) + elseif (POSITIONP REGION) + THEN + (* ;; + "This is a reference position providing the horizontal midpoint of the graph region and the top") + + (RELCREATEREGION WIDTH HEIGHT 'LEFT 'TOP (IDIFFERENCE (FETCH (POSITION XCOORD) + OF REGION) + (IQUOTIENT WIDTH 2)) + (FETCH (POSITION YCOORD) OF REGION)) + ELSE (CLEARW (GETPROMPTWINDOW WINDOW)) + (printout (GETPROMPTWINDOW WINDOW) + "Please specify a region for the comparison graph" T) (* ;; "I don't know why the graphregion doesn't include the last line") - (SETQ REGION (RELGETREGION (IPLUS (TIMES 2 WBorder) - GWIDTH) - [IMIN 200 (IPLUS (FETCH (REGION HEIGHT) OF GRAPHREGION) - (ITIMES 2 (FONTHEIGHT DEFAULTFONT] - 'RIGHT - 'TOP] - [SETQ WINDOW (CREATEW REGION (CONCAT "Compare text" (CL:IF FILEPREFIX - (CONCAT " of " FILEPREFIX) - "") - " showing " - (CL:IF (GRAPHERPROP GRAPH 'ALLCHUNKS) - "all" - "only different") - " chunks, hashed by " - (SELECTQ (GRAPHERPROP GRAPH 'HASH.TYPE) - (PARA "paragraph") - (LINE "line") - (WORD "word") - (SHOULDNT] + (RELCREATEREGION WIDTH HEIGHT 'RIGHT 'TOP REGION))) + [SETQ WINDOW (CREATEW REGION (OR TITLE (CONCAT "Compare text" (CL:IF FILEPREFIX + (CONCAT " of " FILEPREFIX) + "") + " showing " + (CL:IF (GRAPHERPROP GRAPH 'ALLCHUNKS) + "all" + "only different") + " chunks, hashed by " + (SELECTQ (GRAPHERPROP GRAPH 'HASH.TYPE) + (PARA "paragraph") + (LINE "line") + (WORD "word") + (SHOULDNT] (GETPROMPTWINDOW WINDOW) - (CL:WHEN (EQ GWIDTH (FETCH (REGION WIDTH) OF (WINDOWREGION WINDOW))) - (WINDOWPROP WINDOW 'MAXSIZE (CONS GWIDTH MAX.SMALLP))) + (CL:WHEN (EQ WIDTH (FETCH (REGION WIDTH) OF (WINDOWREGION WINDOW))) + (WINDOWPROP WINDOW 'MAXSIZE (CONS WIDTH MAX.SMALLP))) (GETPROMPTWINDOW WINDOW) [WINDOWADDPROP WINDOW 'CLOSEFN (FUNCTION (LAMBDA (W) (LET (TOBJ TWINDOW) @@ -122,41 +130,37 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation. WINDOW]) (COMPARETEXT.TEXTOBJ - [LAMBDA (NODE WINDOW INCOL1) (* ; "Edited 30-Dec-2021 21:21 by rmk") + [LAMBDA (NODE WINDOW INCOL1) (* ; "Edited 27-Jan-2022 13:14 by rmk") + (* ; "Edited 23-Jan-2022 16:51 by rmk") + (* ; "Edited 20-Jan-2022 22:29 by rmk") + (* ; "Edited 19-Jan-2022 08:52 by rmk") + (* ; "Edited 30-Dec-2021 21:21 by rmk") (* ; "Edited 27-Dec-2021 15:56 by rmk") (* ;; "Returns the text object for the chunk column in the graphwindow WINDOW, on the left if INCOL1. If the windows are automatic, they are lined up under the middle of WINDOW.") (DECLARE (USEDFREE COMPARETEXT.AUTOTEDIT)) - (LET (TEXTOBJ TSTREAM TWINDOW REGION (NODEID (FETCH (GRAPHNODE NODEID) OF NODE))) + (LET (TEXTOBJ TSTREAM TWINDOW REGION REGIONARGS (NODEID (FETCH (GRAPHNODE NODEID) OF NODE))) (CL:UNLESS [AND [SETQ TEXTOBJ (WINDOWPROP WINDOW (CL:IF INCOL1 'COL1TEXTOBJ 'COL2TEXTOBJ)] (OPENWP (WFROMDS (TEXTSTREAM TEXTOBJ] - (SETQ REGION (RELCREATEREGION 475 600 (CL:IF INCOL1 - 'RIGHT - 'LEFT) - 'TOP - (CL:IF INCOL1 - `(,WINDOW 0.5 -1) - `(,WINDOW 0.5 1)) - `(,WINDOW BOTTOM -2) - T)) + (SETQ REGIONARGS (LIST 700 600 (CL:IF INCOL1 + 'RIGHT + 'LEFT) + 'TOP + `(,WINDOW 0.5 ,(CL:IF INCOL1 + -1 + 1)) + `(,WINDOW BOTTOM -2) + T)) + (SETQ REGION (CL:IF COMPARETEXT.AUTOTEDIT + (RELCREATEREGION REGIONARGS) + (RELGETREGION REGIONARGS))) [SETQ TSTREAM (TEXTSTREAM (TEDIT (CL:IF (FIXP (CAR NODEID)) (FETCH (IMCOMPARE.CHUNK FILENAME) of NODEID) NODEID) - (IF COMPARETEXT.AUTOTEDIT - THEN - (* ;; - "Just use it as created, don't prompt for adjustments") - - REGION - ELSE (RELGETREGION REGION NIL (CL:IF INCOL1 - 'RIGHT - 'LEFT) - 'TOP)) - NIL - `(READONLY T LEAVETTY T] + REGION NIL `(READONLY T LEAVETTY T] (SETQ TWINDOW (WFROMDS TSTREAM)) (SETQ TEXTOBJ (TEXTOBJ TSTREAM)) (WINDOWPROP WINDOW (CL:IF INCOL1 @@ -173,20 +177,24 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation. WINDOWPOSITION W))) TOBJ TW) - (CL:WHEN (SETQ TOBJ (WINDOWPROP - W - 'COL1TEXTOBJ)) - (MOVEW (SETQ TW (WFROMDS (TEXTSTREAM - TOBJ))) - (PTPLUS DELTA (WINDOWPOSITION - TW)))) - (CL:WHEN (SETQ TOBJ (WINDOWPROP - W - 'COL2TEXTOBJ)) - (MOVEW (SETQ TW (WFROMDS (TEXTSTREAM - TOBJ))) - (PTPLUS DELTA (WINDOWPOSITION - TW)))) + (CL:WHEN [AND (SETQ TOBJ + (WINDOWPROP W + 'COL1TEXTOBJ)) + (SETQ TW + (WFROMDS (TEXTSTREAM + TOBJ] + (MOVEW TW (PTPLUS DELTA ( + WINDOWPOSITION + TW)))) + (CL:WHEN [AND (SETQ TOBJ + (WINDOWPROP W + 'COL2TEXTOBJ)) + (SETQ TW + (WFROMDS (TEXTSTREAM + TOBJ] + (MOVEW TW (PTPLUS DELTA ( + WINDOWPOSITION + TW)))) NIL]) TEXTOBJ]) @@ -246,7 +254,7 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation. (WINDOWPROP WINDOW 'LASTNODES (LIST NODE1 NODE2]) (IMCOMPARE.CHUNKS - [LAMBDA (CHUNK1 CHUNK2 HASH.TYPE REGION FILELABELS) (* ; "Edited 25-Dec-2021 13:02 by rmk") + [LAMBDA (CHUNK1 CHUNK2 HASH.TYPE REGION FILELABELS TITLE) (* ; "Edited 12-Jan-2022 10:06 by rmk") (* ; "Edited 23-Dec-2021 00:02 by rmk") (* ; "Edited 8-Sep-1984 00:06 by rmk") @@ -302,11 +310,13 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation. (* ;; "The file comparison is complete. Format and display the file difference graph") - (IMCOMPARE.DISPLAYGRAPH CHUNK1 CHUNK2 HASH.TYPE REGION CHUNKLIST1 CHUNKLIST2 FILELABELS]) + (IMCOMPARE.DISPLAYGRAPH CHUNK1 CHUNK2 HASH.TYPE REGION CHUNKLIST1 CHUNKLIST2 FILELABELS + TITLE]) (IMCOMPARE.COLLECT.HASH.CHUNKS - [LAMBDA (CHUNK HASH.TYPE) (* ; "Edited 24-Dec-2021 22:30 by rmk") - (* ; "Edited 13-Dec-2021 16:32 by rmk") + [LAMBDA (CHUNK HASH.TYPE) (* ; "Edited 20-Jan-2022 23:09 by rmk") + (* ; "Edited 24-Dec-2021 22:30 by rmk") + (* ; "Edited 13-Dec-2021 16:32 by rmk") (* ; "Edited 23-Dec-98 16:54 by rmk:") (* mjs " 8-Jan-84 20:57") @@ -338,11 +348,12 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation. (fetch (IMCOMPARE.CHUNK CHUNKLENGTH) of CHUNK))) WHILE (SETQ CHUNK (IMCOMPARE.HASH STREAM HASH.TYPE ENDPOS)) - COLLECT (REPLACE FILENAME OF CHUNK WITH FILENAME) + COLLECT (REPLACE (IMCOMPARE.CHUNK FILENAME) OF CHUNK WITH FILENAME) CHUNK))]) (IMCOMPARE.DISPLAYGRAPH - [LAMBDA (CHUNK1 CHUNK2 HASH.TYPE REGION CHUNKLIST1 CHUNKLIST2 FILELABELS) + [LAMBDA (CHUNK1 CHUNK2 HASH.TYPE REGION CHUNKLIST1 CHUNKLIST2 FILELABELS TITLE) + (* ; "Edited 12-Jan-2022 09:58 by rmk") (* ; "Edited 27-Dec-2021 11:58 by rmk") (* ; "Edited 23-Dec-2021 00:14 by rmk") (* mjs "11-Jul-85 09:10") @@ -459,7 +470,7 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation. COL1X ,COL1X COL2X ,COL2X ALLCHUNKS ,COMPARETEXT.ALLCHUNKS] - (SHOWGRAPH GRAPH (COMPARETEXT.WINDOW GRAPH REGION) + (SHOWGRAPH GRAPH (COMPARETEXT.WINDOW GRAPH REGION TITLE) (FUNCTION IMCOMPARE.LEFTBUTTONFN) (FUNCTION IMCOMPARE.MIDDLEBUTTONFN) T NIL]) @@ -770,12 +781,12 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation. ) (PUTPROPS COMPARETEXT COPYRIGHT ("Xerox Corporation" 1984 1985 1993 1998)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1344 41549 (COMPARETEXT 1354 . 2933) (COMPARETEXT.WINDOW 2935 . 7132) ( -COMPARETEXT.TEXTOBJ 7134 . 12023) (COMPARETEXT.SETSEL 12025 . 12815) (CHUNKNODELABEL 12817 . 13938) ( -IMCOMPARE.BOXNODE 13940 . 14707) (IMCOMPARE.CHUNKS 14709 . 19062) (IMCOMPARE.COLLECT.HASH.CHUNKS 19064 - . 21842) (IMCOMPARE.DISPLAYGRAPH 21844 . 29570) (IMCOMPARE.HASH 29572 . 33759) ( -IMCOMPARE.MERGE.CONNECTED.CHUNKS 33761 . 37257) (IMCOMPARE.MERGE.UNCONNECTED.CHUNKS 37259 . 39214) ( -IMCOMPARE.SHOW.DIST 39216 . 39662) (IMCOMPARE.UPDATE.SYMBOL.TABLE 39664 . 41547)) (41550 47707 ( -IMCOMPARE.LEFTBUTTONFN 41560 . 44137) (IMCOMPARE.MIDDLEBUTTONFN 44139 . 47255) (IMCOMPARE.COPYBUTTONFN - 47257 . 47705)) (47760 48451 (TAIL1 47770 . 48124) (TAIL2 48126 . 48449))))) + (FILEMAP (NIL (1345 42591 (COMPARETEXT 1355 . 2855) (COMPARETEXT.WINDOW 2857 . 7675) ( +COMPARETEXT.TEXTOBJ 7677 . 12786) (COMPARETEXT.SETSEL 12788 . 13578) (CHUNKNODELABEL 13580 . 14701) ( +IMCOMPARE.BOXNODE 14703 . 15470) (IMCOMPARE.CHUNKS 15472 . 19848) (IMCOMPARE.COLLECT.HASH.CHUNKS 19850 + . 22767) (IMCOMPARE.DISPLAYGRAPH 22769 . 30612) (IMCOMPARE.HASH 30614 . 34801) ( +IMCOMPARE.MERGE.CONNECTED.CHUNKS 34803 . 38299) (IMCOMPARE.MERGE.UNCONNECTED.CHUNKS 38301 . 40256) ( +IMCOMPARE.SHOW.DIST 40258 . 40704) (IMCOMPARE.UPDATE.SYMBOL.TABLE 40706 . 42589)) (42592 48749 ( +IMCOMPARE.LEFTBUTTONFN 42602 . 45179) (IMCOMPARE.MIDDLEBUTTONFN 45181 . 48297) (IMCOMPARE.COPYBUTTONFN + 48299 . 48747)) (48802 49493 (TAIL1 48812 . 49166) (TAIL2 49168 . 49491))))) STOP