github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-01-12 00:42:56 +00:00
Code Issues Projects Releases Wiki Activity

Comparison tools: Cosmetic fixes, a few glitches

Browse Source
This commit is contained in:
rmkaplan 2022-02-19 18:37:42 -08:00
parent c4fac75f0a
commit db8c951887
11 changed files with 477 additions and 322 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

253
lispusers/COMPAREDIRECTORIES
View File

@ -1,13 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "29-Jan-2022 00:03:59" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;169 111694
(FILECREATED "18-Feb-2022 17:05:27" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;189 119161
:CHANGES-TO (FNS CD-MENUFN)
(VARS CDTABLEBROWSER.MENUITEMS)
:PREVIOUS-DATE "28-Jan-2022 17:12:22"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;162)
:PREVIOUS-DATE "11-Feb-2022 16:21:21"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;188)
(* ; "
@ -52,7 +51,8 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
TABLEBROWSER))
(FNS CD.TABLEITEM CD.TABLEITEM.PRINTFN CD.TABLEITEM.COPYFN
CDTABLEBROWSER.HEADING.REPAINTFN)
(FNS CDTABLEBROWSER.WHENSELECTEDFN CD.COMMANDSELECTEDFN CD-MENUFN)
(FNS CDTABLEBROWSER.WHENSELECTEDFN CD.COMMANDSELECTEDFN CD-MENUFN CDBROWSER-COPY
CDBROWSER-DELETE-FILE CD-SWAPDIRS)
(VARS CDTABLEBROWSER.MENUITEMS)
(FILES (SYSLOAD)
COMPARESOURCES COMPARETEXT))))
@ -65,7 +65,9 @@ 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 26-Jan-2022 13:33 by rmk")
FIXDIRECTORYDATES) (* ; "Edited 4-Feb-2022 13:44 by rmk")
(* ; "Edited 31-Jan-2022 21:52 by rmk")
(* ; "Edited 26-Jan-2022 13:33 by rmk")
(* ; "Edited 4-Jan-2022 12:09 by rmk")
(* ; "Edited 31-Oct-2021 11:01 by rmk:")
(* ; "Edited 7-Jan-2021 23:21 by rmk:")
@ -108,9 +110,9 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
(SETQ DEPTH2 T)
(SETQ DIR2 (SUBSTRING DIR2 1 -2)))
(SETQ DIR1 (OR (DIRECTORYNAME (OR DIR1 T))
(ERROR "DIRECTORY DOES NOT EXIST" DIR1)))
DIR1))
(SETQ DIR2 (OR (DIRECTORYNAME (OR DIR2 T))
(ERROR "DIRECTORY DOES NOT EXIST" DIR2)))
DIR2))
(CL:WHEN FIXDIRECTORYDATES
(PRINTOUT T "Fixing directory dates" T)
(FIX-DIRECTORY-DATES DIR1)
@ -153,12 +155,12 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
(* ;; "Could be some 2's without 1's")
(SORT [NCONC CANDIDATES (for I2 in INFOS2 unless (ASSOC (CAR I2)
CANDIDATES)
collect (LIST (CAR I2)
NIL
(CDR I2]
T)
(SETQ CANDIDATES (SORT [NCONC CANDIDATES (for I2 in INFOS2 unless (ASSOC (CAR I2)
CANDIDATES)
collect (LIST (CAR I2)
NIL
(CDR I2]
T))
(* ;; "CANDIDATES is now a sorted list of the form (matchname entry1 entry2) where an entry consists of (fullname date length author)")
@ -1758,7 +1760,8 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
'DON'T])
(CD.COMMANDSELECTEDFN
[LAMBDA (MENUITEM MENU KEY) (* ; "Edited 27-Jan-2022 17:46 by rmk")
[LAMBDA (MENUITEM MENU KEY) (* ; "Edited 5-Feb-2022 17:23 by rmk")
(* ; "Edited 27-Jan-2022 17:46 by rmk")
(* ; "Edited 10-Jan-2022 22:51 by rmk")
(* ; "Edited 25-Dec-2021 11:20 by rmk")
(* ; "Edited 12-Jan-87 12:57 by bvm:")
@ -1810,24 +1813,24 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
(CD-MENUFN
[LAMBDA (TBITEM MENUITEM CDBROWSER KEY)
(* ;; "Edited 29-Jan-2022 00:03 by rmk: FILELABELFN, if provided, can be used to calculate abbreviated labels for the file, for example, to strip off any long common prefixes.")
(* ;; "Edited 18-Feb-2022 16:56 by rmk: FILELABELFN, if provided, can be used to calculate abbreviated labels for the file, for example, to strip off any long common prefixes.")
(* ;; "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 <this function> . extrainfo). The selector for the selectq is either the CAR of the extrainfo or the display atom.")
(CL:WHEN (MEMB (OR (CADDR MENUITEM)
(CAR MENUITEM))
'(Compare See See% right See% both See% left))
(DECLARE (USEDFREE CDENTRY LABEL1 LABLE2 FILE1 FILE2 WINDOW))
(SETQ MENUITEM (OR (CADDR MENUITEM)
(CAR MENUITEM)))
(CL:WHEN (MEMB MENUITEM '(Compare See See% right See% both See% left))
(* ; "Close the previous ones")
(CLOSEWITH.DOIT WINDOW))
(LET
(CHILDREN)
(SETQ CHILDREN
(SELECTQ (OR (CADDR MENUITEM)
(CAR MENUITEM))
(SELECTQ MENUITEM
(Compare (IF (AND FILE1 FILE2)
THEN (SELECTQ TYPE
THEN [SELECTQ TYPE
(SOURCE (CSBROWSER FILE1 FILE2 NIL LABEL1 LABEL2
(RELCREATEREGION
[FIXR (TIMES 0.75 (FETCH (REGION WIDTH)
@ -1840,11 +1843,11 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
(IPLUS (FETCH (REGION BOTTOM)
OF (WINDOWPROP WINDOW 'REGION))
20)
T)))
NIL)))
(COMPILED (FLASHWINDOW T)
(PRIN3 "Cannot compare compiled files" T))
((TEXT TEDIT)
(* ;;
((TEXT TEDIT OTHER)
(* ;;
 "Works for TEDIT, but doesn't detect image object differences")
(COMPARETEXT FILE1 FILE2 'LINE
@ -1855,7 +1858,13 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
(LIST LABEL1 LABEL2)))
(PROGN (FLASHWINDOW T)
(PRIN3 "Unable to compare, showing both" T)
(TEDIT-SEE-VERSIONS FILE1 FILE2 LABEL1 LABEL2)))
(EXAMINEFILES FILE1 FILE2 LABEL1 LABEL2
(RELCREATEREGION 1400 700 'LEFT 'TOP
`(,WINDOW 0.5 -701)
(IPLUS (FETCH (REGION BOTTOM)
OF (WINDOWPROP WINDOW 'REGION))
-1)
NIL]
ELSE (FLASHWINDOW T)
(PRIN3 "Only one file" T)))
(See% left (IF FILE1
@ -1875,36 +1884,143 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
(IPLUS (FETCH (REGION BOTTOM)
OF (WINDOWPROP WINDOW 'REGION))
-1)
T)
NIL)
NIL
(CONCAT "SEE window for " LABEL2))
ELSE (FLASHWINDOW T)
(PRIN3 "No file to print" T)))
((See See% both)
(IF (AND FILE1 FILE2)
THEN (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)))
(EXAMINEFILES FILE1 FILE2 LABEL1 LABEL2 (RELCREATEREGION
1400 700 'LEFT 'TOP `(,WINDOW 0.5 -701)
(IPLUS (FETCH (REGION BOTTOM)
OF (WINDOWPROP WINDOW 'REGION))
-1)
NIL)))
(Copy% -> (CDBROWSER-COPY CDBROWSER TBITEM 'LEFT))
(Copy% <- (CDBROWSER-COPY CDBROWSER TBITEM 'RIGHT))
(Delete% <- (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'LEFT T))
(|Delete ALL <-|
(CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'LEFT NIL))
(Delete% -> (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'RIGHT T))
(|Delete ALL ->|
(CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'RIGHT NIL))
(SHOULDNT)))
(CLOSEWITH CHILDREN WINDOW)
(MOVEWITH CHILDREN WINDOW])
(CDBROWSER-COPY
[LAMBDA (CDBROWSER TBITEM SOURCE) (* ; "Edited 5-Feb-2022 17:27 by rmk")
(* ; "Edited 2-Feb-2022 22:18 by rmk")
(* ;; "Copies the file identified as SOURCE (LEFT or RIGHT) in CDENTRY to the other file of the end. If the destination file is missing, it is assumed to be a new/unversioned file of the same name as the source but with the directory prefix switched. CDVALUE needed to know what directory prefixes are involved.")
(* ;; "Returns NIL if the copy fails.")
(CL:UNLESS (TB.ITEM.DELETED? CDBROWSER TBITEM)
(PROG* ((CDVALUE (LISTGET (TB.USERDATA CDBROWSER)
'CDVALUE))
(SOURCEDIR (FETCH (CDVALUE CDDIR1) OF CDVALUE))
(DESTDIR (FETCH (CDVALUE CDDIR2) OF CDVALUE))
(CDENTRY (CADR (FETCH TIDATA OF TBITEM)))
(SOURCEINFO (FETCH (CDENTRY INFO1) OF CDENTRY))
(DESTINFO (FETCH (CDENTRY INFO2) OF CDENTRY))
SOURCEFILE DESTFILE SOURCEVER (DATERELBAD '<)
RESULT)
(* ;; "Start assuming LEFT, switch if RIGHT")
(CL:WHEN (EQ SOURCE 'RIGHT)
(SWAP SOURCEINFO DESTINFO)
(SWAP SOURCEDIR DESTDIR)
(SETQ DATERELBAD '>))
(SETQ SOURCEFILE (FETCH (CDINFO FULLNAME) OF SOURCEINFO))
(SETQ DESTFILE (FETCH (CDINFO FULLNAME) OF DESTINFO))
(CLEARW T)
(CL:UNLESS SOURCEFILE
(PRIN3 "No source file to copy" T)
(RETURN NIL))
(CL:WHEN [AND (EQ DATERELBAD (FETCH (CDENTRY DATEREL) OF CDENTRY))
(PROGN (FLASHWINDOW T)
(EQ 'N (ASKUSER NIL NIL
"Target is newer than source. Really copy? "]
(RETURN NIL))
(CL:WHEN [AND (SETQ SOURCEVER (FILENAMEFIELD SOURCE 'VERSION))
(ILESSP SOURCEVER (FILENAMEFIELD (INFILEP (PACKFILENAME 'VERFSION NIL
'BODY SOURCEFILE))
'VERSION))
(PROGN (FLASHWINDOW T)
(EQ 'N (ASKUSER NIL NIL (CONCAT SOURCEFILE
" is not the newest version. Really copy? "
]
(RETURN NIL))
(CLEARW T)
(CL:UNLESS DESTFILE
(SETQ DESTFILE (CD-SWAPDIRS SOURCEFILE SOURCEDIR DESTDIR)))
(SETQ RESULT (COPYFILE SOURCEFILE (PACKFILENAME 'VERSION NIL 'BODY DESTFILE)))
(PRIN3 (IF RESULT
THEN (TB.DELETE.ITEM CDBROWSER TBITEM)
(CONCAT "Copied to " RESULT)
ELSE (FLASHWINDOW T)
(CONCAT SOURCEFILE " could not be copied"))
T)
(RETURN RESULT)))])
(CDBROWSER-DELETE-FILE
[LAMBDA (CDBROWSER TBITEM SIDE ONLYONE SAVE) (* ; "Edited 5-Feb-2022 17:46 by rmk")
(* ; "Edited 18-Jan-2022 23:02 by rmk")
(* ; "Edited 19-Dec-2021 23:33 by rmk")
(* ;; "FILE is a full filename from a CDENTRY, and it will be removed. Unless ONLYONE and FILE has a version number, then all previous versions of the file are also removed so tha the next earliest version doesn't reemerge.")
(* ;; "The deleted directory should be pruned separately, from time to time. ")
(* ;; " Presumably SAVE is NIL for a git host, since git can restore on its own.")
(* ;; "If SAVE, then the files are renamed to a deleted directory, not actually expunged, so that they can be restored if needed. The deleted directory is defined by sticking deleted> on the front of FILE's directory.")
(CL:UNLESS (TB.ITEM.DELETED? CDBROWSER TBITEM)
[LET ((CDENTRY (CADR (FETCH TIDATA OF TBITEM)))
FILE OTHERFILE)
(SETQ FILE (FETCH (CDINFO FULLNAME) OF (FETCH (CDENTRY INFO1) OF CDENTRY)))
(SETQ OTHERFILE (FETCH (CDINFO FULLNAME) OF (FETCH (CDENTRY INFO2) OF CDENTRY)))
(CL:WHEN (EQ SIDE 'RIGHT)
(SWAP FILE OTHERFILE))
(CL:WHEN FILE
(FOR F INSIDE (IF (FILENAMEFIELD FILE 'VERSION)
THEN [IF ONLYONE
THEN FILE
ELSE (DREVERSE (FILDIR (PACKFILENAME 'VERSION '*
'BODY FILE]
ELSE FILE)
COLLECT
(* ;; "Delete the earlier ones first, if it goes bad, you don't want them to persist. This preserves the original version numbers, maybe it should start fresh from 1 (or from whatever might have been deleted before).")
(IF SAVE
THEN (CL:UNLESS (RENAMEFILE F (PACKFILENAME 'DIRECTORY
(CONCAT "deleted>"
(FILENAMEFIELD F
'DIRECTORY))
'BODY F))
(ERROR "Could not delete " F))
ELSE (DELFILE FILE))
F FINALLY
(* ;; "Perhaps only mark it as deleted if both files are gone?")
(TB.DELETE.ITEM CDBROWSER TBITEM)))])])
(CD-SWAPDIRS
[LAMBDA (FILE FROMDIR TODIR KEEPVERSION) (* ; "Edited 2-Feb-2022 19:10 by rmk")
(* ;; "Replaces prefix FROMDIR of FILE with TODIR")
(IF (STRPOS FROMDIR FILE 1 NIL NIL T FILEDIRCASEARRAY)
THEN [SETQ FILE (CONCAT TODIR (SUBSTRING FILE (ADD1 (NCHARS FROMDIR]
(CL:IF KEEPVERSION
FILE
(PACKFILENAME.STRING 'VERSION NIL 'BODY FILE))
ELSE (ERROR FILE (CONCAT " doesn't begin with " FROMDIR])
)
(RPAQQ CDTABLEBROWSER.MENUITEMS ((Compare CD-MENUFN)
@ -1920,23 +2036,24 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
(PUTPROPS COMPAREDIRECTORIES COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1994 1998
2018 2020 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2536 19051 (COMPAREDIRECTORIES 2546 . 8995) (COMPAREDIRECTORIES.INFOS 8997 . 11117) (
CDENTRIES.SELECT 11119 . 15805) (COMPAREDIRECTORIES.INFOS.TYPE 15807 . 16435) (MATCHNAME 16437 . 16967
) (CD.INSURECDVALUE 16969 . 18583) (CD.UPDATEWIDTHS 18585 . 19049)) (19052 29324 (CDFILES 19062 .
25418) (CDFILES.MATCH 25420 . 27045) (CDFILES.PATS 27047 . 29322)) (29325 44410 (CDPRINT 29335 . 31680
) (CDPRINT.HEADER 31682 . 32579) (CDPRINT.LINE 32581 . 35137) (CDPRINT.MAXWIDTHS 35139 . 39254) (
CDPRINT.COLHEADERS 39256 . 39894) (CDPRINT.COLUMNS 39896 . 43775) (CDTEDIT 43777 . 44408)) (44411
52780 (CDMAP 44421 . 45853) (CDENTRY 45855 . 46164) (CDSUBSET 46166 . 47605) (CDMERGE 47607 . 51461) (
CDMERGE.COMMON 51463 . 52778)) (52781 60319 (BINCOMP 52791 . 57080) (EOLTYPE 57082 . 59644) (
EOLTYPE.SHOW 59646 . 60317)) (60847 74054 (FIND-UNCOMPILED-FILES 60857 . 64500) (FIND-UNSOURCED-FILES
64502 . 67311) (FIND-SOURCE-FILES 67313 . 69017) (FIND-COMPILED-FILES 69019 . 71097) (
FIND-UNLOADED-FILES 71099 . 71843) (FIND-LOADED-FILES 71845 . 72399) (FIND-MULTICOMPILED-FILES 72401
. 74052)) (74055 82257 (CREATED-AS 74065 . 78862) (SOURCE-FOR-COMPILED-P 78864 . 81562) (
COMPILE-SOURCE-DATE-DIFF 81564 . 82255)) (82258 92564 (FIX-DIRECTORY-DATES 82268 . 85261) (
FIX-EQUIV-DATES 85263 . 86788) (COPY-COMPARED-FILES 86790 . 88611) (COPY-MISSING-FILES 88613 . 90770)
(COMPILED-ON-SAME-SOURCE 90772 . 92562)) (92758 99800 (CDBROWSER 92768 . 96695) (CDBROWSER.STRINGS
96697 . 99798)) (99962 101234 (CD.TABLEITEM 99972 . 100192) (CD.TABLEITEM.PRINTFN 100194 . 100393) (
CD.TABLEITEM.COPYFN 100395 . 100989) (CDTABLEBROWSER.HEADING.REPAINTFN 100991 . 101232)) (101235
111110 (CDTABLEBROWSER.WHENSELECTEDFN 101245 . 101713) (CD.COMMANDSELECTEDFN 101715 . 105106) (
CD-MENUFN 105108 . 111108)))))
(FILEMAP (NIL (2555 19321 (COMPAREDIRECTORIES 2565 . 9265) (COMPAREDIRECTORIES.INFOS 9267 . 11387) (
CDENTRIES.SELECT 11389 . 16075) (COMPAREDIRECTORIES.INFOS.TYPE 16077 . 16705) (MATCHNAME 16707 . 17237
) (CD.INSURECDVALUE 17239 . 18853) (CD.UPDATEWIDTHS 18855 . 19319)) (19322 29594 (CDFILES 19332 .
25688) (CDFILES.MATCH 25690 . 27315) (CDFILES.PATS 27317 . 29592)) (29595 44680 (CDPRINT 29605 . 31950
) (CDPRINT.HEADER 31952 . 32849) (CDPRINT.LINE 32851 . 35407) (CDPRINT.MAXWIDTHS 35409 . 39524) (
CDPRINT.COLHEADERS 39526 . 40164) (CDPRINT.COLUMNS 40166 . 44045) (CDTEDIT 44047 . 44678)) (44681
53050 (CDMAP 44691 . 46123) (CDENTRY 46125 . 46434) (CDSUBSET 46436 . 47875) (CDMERGE 47877 . 51731) (
CDMERGE.COMMON 51733 . 53048)) (53051 60589 (BINCOMP 53061 . 57350) (EOLTYPE 57352 . 59914) (
EOLTYPE.SHOW 59916 . 60587)) (61117 74324 (FIND-UNCOMPILED-FILES 61127 . 64770) (FIND-UNSOURCED-FILES
64772 . 67581) (FIND-SOURCE-FILES 67583 . 69287) (FIND-COMPILED-FILES 69289 . 71367) (
FIND-UNLOADED-FILES 71369 . 72113) (FIND-LOADED-FILES 72115 . 72669) (FIND-MULTICOMPILED-FILES 72671
. 74322)) (74325 82527 (CREATED-AS 74335 . 79132) (SOURCE-FOR-COMPILED-P 79134 . 81832) (
COMPILE-SOURCE-DATE-DIFF 81834 . 82525)) (82528 92834 (FIX-DIRECTORY-DATES 82538 . 85531) (
FIX-EQUIV-DATES 85533 . 87058) (COPY-COMPARED-FILES 87060 . 88881) (COPY-MISSING-FILES 88883 . 91040)
(COMPILED-ON-SAME-SOURCE 91042 . 92832)) (93028 100070 (CDBROWSER 93038 . 96965) (CDBROWSER.STRINGS
96967 . 100068)) (100232 101504 (CD.TABLEITEM 100242 . 100462) (CD.TABLEITEM.PRINTFN 100464 . 100663)
(CD.TABLEITEM.COPYFN 100665 . 101259) (CDTABLEBROWSER.HEADING.REPAINTFN 101261 . 101502)) (101505
118577 (CDTABLEBROWSER.WHENSELECTEDFN 101515 . 101983) (CD.COMMANDSELECTEDFN 101985 . 105485) (
CD-MENUFN 105487 . 111662) (CDBROWSER-COPY 111664 . 115035) (CDBROWSER-DELETE-FILE 115037 . 118056) (
CD-SWAPDIRS 118058 . 118575)))))
STOP

BIN
lispusers/COMPAREDIRECTORIES.LCOM
View File

Binary file not shown.

6
lispusers/COMPAREDIRECTORIES.TEDIT
View File

File diff suppressed because one or more lines are too long

BIN
lispusers/COMPARETEXT.LCOM
View File

Binary file not shown.

56
lispusers/EXAMINEDEFS
View File

@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "28-Jan-2022 23:36:31" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>EXAMINEDEFS.;32 11715
(FILECREATED " 1-Feb-2022 23:15:24" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>EXAMINEDEFS.;36 11920
:CHANGES-TO (FNS TEDITDEF)
:CHANGES-TO (FNS EXAMINEFILES)
:PREVIOUS-DATE "25-Jan-2022 10:20:31"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>EXAMINEDEFS.;31)
:PREVIOUS-DATE " 1-Feb-2022 15:43:17"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>EXAMINEDEFS.;35)
(PRETTYCOMPRINT EXAMINEDEFSCOMS)
@ -19,7 +19,8 @@
(DEFINEQ
(EXAMINEDEFS
[LAMBDA (NAME TYPE SOURCE1 SOURCE2 TITLE1 TITLE2 REGION) (* ; "Edited 23-Jan-2022 17:40 by rmk")
[LAMBDA (NAME TYPE SOURCE1 SOURCE2 TITLE1 TITLE2 REGION) (* ; "Edited 1-Feb-2022 15:42 by rmk")
(* ; "Edited 23-Jan-2022 17:40 by rmk")
(* ; "Edited 18-Jan-2022 22:40 by rmk")
(* ; "Edited 12-Jan-2022 17:29 by rmk")
(* ; "Edited 24-Dec-2021 22:39 by rmk")
@ -54,11 +55,9 @@
ELSEIF (GETDEF NAME TYPE SOURCE2)
ELSE (ERROR NAME " not found on " SOURCE2)))
(CL:UNLESS TITLE1
(SETQ TITLE1 (OR (AND SOURCE1 (LITATOM SOURCE1))
"File 1")))
(SETQ TITLE1 (OR SOURCE1 "File 1")))
(CL:UNLESS TITLE2
(SETQ TITLE2 (OR (AND SOURCE2 (LITATOM SOURCE2))
"File 2")))
(SETQ TITLE2 (OR SOURCE2 "File 2")))
(SELECTQ (EDITMODE)
(SEDIT:SEDIT
(* ;;
@ -136,28 +135,29 @@
(EDITE DEF2])
(EXAMINEFILES
[LAMBDA (FILE1 FILE2 TITLE1 TITLE2 REGION) (* ; "Edited 25-Jan-2022 10:08 by rmk")
[LAMBDA (FILE1 FILE2 TITLE1 TITLE2 REGION) (* ; "Edited 1-Feb-2022 23:15 by rmk")
(* ; "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?")
(* ;; "We get a region, then split it in half. ")
(CL:UNLESS REGION
(SETQ REGION (GETREGION)))
(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])
(LIST (AND FILE1 (TEDIT-SEE FILE1 (RELCREATEREGION `(,REGION 0.5 -1)
REGION
'RIGHT
'TOP
`(,REGION 0.5)
(FETCH (REGION TOP) OF REGION))
NIL TITLE1))
(AND FILE2 (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 28-Jan-2022 23:36 by rmk")
@ -199,6 +199,6 @@
(FILESLOAD (SYSLOAD)
COMPARETEXT)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (658 11573 (EXAMINEDEFS 668 . 8787) (EXAMINEFILES 8789 . 9984) (TEDITDEF 9986 . 11571)))
))
(FILEMAP (NIL (662 11778 (EXAMINEDEFS 672 . 8792) (EXAMINEFILES 8794 . 10189) (TEDITDEF 10191 . 11776)
))))
STOP

BIN
lispusers/EXAMINEDEFS.LCOM
View File

Binary file not shown.

392
lispusers/GITFNS
View File

@ -1,11 +1,11 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "29-Jan-2022 00:01:52" {DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>GITFNS.;37 56734
(FILECREATED "19-Feb-2022 10:22:09" {DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>GITFNS.;58 58648
:CHANGES-TO (FNS GIT-COMPARE-WITH-MYMEDLEY GIT-COMPARE-BRANCHES)
:PREVIOUS-DATE "28-Jan-2022 12:12:30"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>GITFNS.;36)
:PREVIOUS-DATE "13-Feb-2022 21:27:07"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>GITFNS.;57)
(PRETTYCOMPRINT GITFNSCOMS)
@ -23,10 +23,11 @@
(MYMEDLEYHOST 'MM)
(GITMEDLEYHOST 'GIT))
(INITVARS (GIT-IGNORE-FILES '(EXPORTS.ALL RDSYS RDSYS.LCOM))
(GIT-IGNORE-DIRECTORIES '(LOADUPS PATCHES TMP FONTSOLD DELETED CLOS CLTL2))
(GIT-IGNORE-DIRECTORIES '(loadups patches tmp fontsold deleted clos cltl2))
(GIT-MERGE-COMPARES T))
(P (PSEUDOHOST MYMEDLEYHOST MEDLEYDIR)
(PSEUDOHOST GITMEDLEYHOST GITMEDLEYDIR))
(FNS GIT-CLONEP)
(* ;; "")
@ -40,12 +41,10 @@
(* ;; "File correspondents")
(FNS ALLSUBDIRS MEDLEYSUBDIRS GITSUBDIRS)
(FNS TOGIT FROMGIT GIT-DELETE-FILE MYMEDLEY-DELETE-FILES)
(FNS MEDLEYSUBDIR GITSUBDIR STRIPDIR STRIPHOST)
(FNS MEDLEYSUBDIR GITSUBDIR STRIPDIR STRIPHOST STRIPNAME)
(FNS GFILE4MFILE MFILE4GFILE GIT-REPO-FILENAME)
(FNS MEDLEYSUBDIRS GITSUBDIRS)
(VARS (MEDLEYSUBDIRS (MEDLEYSUBDIRS))
(GITSUBDIRS (GITSUBDIRS)))
(* ;; "")
@ -53,7 +52,7 @@
(* ;; "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)
GIT-REMOTE-UPDATE GIT-REMOTE-ADD GIT-FILE-DATE)
(* ;; "")
@ -106,13 +105,37 @@
(RPAQ? GIT-IGNORE-FILES '(EXPORTS.ALL RDSYS RDSYS.LCOM))
(RPAQ? GIT-IGNORE-DIRECTORIES '(LOADUPS PATCHES TMP FONTSOLD DELETED CLOS CLTL2))
(RPAQ? GIT-IGNORE-DIRECTORIES '(loadups patches tmp fontsold deleted clos cltl2))
(RPAQ? GIT-MERGE-COMPARES T)
(PSEUDOHOST MYMEDLEYHOST MEDLEYDIR)
(PSEUDOHOST GITMEDLEYHOST GITMEDLEYDIR)
(DEFINEQ
(GIT-CLONEP
[LAMBDA (HOST/DIR NOERROR) (* ; "Edited 5-Feb-2022 11:35 by rmk")
(* ;;
 "Returns the canonical git pseudohost for HOST/DIR, NIL if it doesn't denote a git clone. ")
(CL:UNLESS HOST/DIR
(SETQ HOST/DIR '{GIT}))
(CL:UNLESS (EQ (CHARCODE {)
(CHCON1 HOST/DIR))
(SETQ HOST/DIR (CONCAT "{" HOST/DIR "}")))
(SETQ HOST/DIR (TRUEFILENAME HOST/DIR))
(CL:UNLESS (MEMB (NTHCHARCODE HOST/DIR -1)
(CHARCODE (/ > < })))
(SETQ HOST/DIR (CONCAT HOST/DIR "/")))
(IF (DIRECTORYNAMEP (CONCAT HOST/DIR ".git/"))
THEN (PSEUDOFILENAME HOST/DIR)
ELSEIF NOERROR
THEN NIL
ELSE (ERROR (PSEUDOFILENAME HOST/DIR)
"is not a git clone"])
)
@ -167,16 +190,56 @@
(DEFINEQ
(ALLSUBDIRS
[LAMBDA (HOST1 HOST2)
(* ;;
 "Edited 4-Feb-2022 17:57 by rmk: the union of the subdirectories that exist under all the hosts")
(* ;; "Returns the union of the subdirectories that exist under all the hosts")
(LET ((HOSTS (MKLIST HOST1))
VAL)
(CL:WHEN HOST2 (PUSHNEW HOSTS HOST2))
(CL:UNLESS HOSTS
(SETQ HOSTS (LIST MYMEDLEYHOST GITMEDLEYHOST)))
(SORT (FOR H VAL IN HOSTS
JOIN (FOR F IN (FILDIR (PACKFILENAME 'HOST H 'BODY '*)) WHEN (DIRECTORYNAMEP F)
UNLESS (OR [EQ (CHARCODE %.)
(CHCON1 (SETQ D (FILENAMEFIELD F 'DIRECTORY]
(THEREIS SKIP IN GIT-IGNORE-DIRECTORIES
SUCHTHAT (STRPOS SKIP D 1 NIL T NIL FILEDIRCASEARRAY)))
DO (SETQ D (UNSLASHIT (L-CASE D)))
(CL:UNLESS (MEMBER D VAL)
(PUSH VAL D))) FINALLY (RETURN VAL])
(MEDLEYSUBDIRS
[LAMBDA (MEDLEYHOST ALLSUBDIRS) (* ; "Edited 4-Feb-2022 18:06 by rmk")
(CL:UNLESS MEDLEYHOST (SETQ MEDLEYHOST MYMEDLEYHOST))
(FOR D IN (OR ALLSUBDIRS (ALLSUBDIRS)) COLLECT (UNSLASHIT (PACKFILENAME 'HOST MEDLEYHOST
'DIRECTORY D)
T])
(GITSUBDIRS
[LAMBDA (GITHOST ALLSUBDIRS) (* ; "Edited 4-Feb-2022 18:06 by rmk")
(CL:UNLESS GITHOST (SETQ GITHOST GITMEDLEYHOST))
(FOR D IN (OR ALLSUBDIRS (ALLSUBDIRS)) COLLECT (SLASHIT (PACKFILENAME 'HOST GITHOST 'DIRECTORY D)
T])
)
(DEFINEQ
(TOGIT
[LAMBDA (MFILES) (* ; "Edited 19-Jan-2022 23:35 by rmk")
[LAMBDA (MFILES) (* ; "Edited 4-Feb-2022 18:08 by rmk")
(* ; "Edited 2-Feb-2022 18:56 by rmk")
(* ; "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))
(CL:WHEN (STRPOS "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)
(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
@ -195,8 +258,9 @@
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)
[LAMBDA (GFILES) (* ; "Edited 4-Feb-2022 18:08 by rmk")
(* ; "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))
@ -276,27 +340,35 @@
(CL:IF POS
(SUBSTRING NAME (ADD1 POS))
NAME)])
(STRIPNAME
[LAMBDA (FILE)
(* ;; "Edited 5-Feb-2022 08:38 by rmk: the name/ext/version of FILE without disturbing host or directory. Strips everything after last / >")
(* ;; "Removes the name/ext/version of FILE without disturbing host or directory. Strips everything after last / >")
(FOR I LASTDIRPOS FROM 1 DO (SELCHARQ (NTHCHARCODE FILE I)
((> < /)
(SETQ LASTDIRPOS I))
(NIL (RETURN (CL:IF LASTDIRPOS
(SUBSTRING FILE 1 LASTDIRPOS)
FILE)))
NIL])
)
(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]
[LAMBDA (MFILE GITHOST) (* ; "Edited 4-Feb-2022 18:04 by rmk")
(SLASHIT (PACKFILENAME 'HOST (OR GITHOST GITMEDLEYHOST)
'VERSION NIL 'BODY MFILE)
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])
[LAMBDA (GFILE MHOST) (* ; "Edited 4-Feb-2022 18:04 by rmk")
(* ; "Edited 18-Jan-2022 15:24 by rmk")
(UNSLASHIT (PACKFILENAME 'HOST (OR MHOST MYMEDLEYHOST)
'VERSION NIL 'BODY GFILE])
(GIT-REPO-FILENAME
[LAMBDA (GFILE) (* ; "Edited 18-Jan-2022 15:42 by rmk")
@ -312,41 +384,6 @@
(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))
@ -413,36 +450,37 @@
(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:")
[LAMBDA (BRANCH GITFILE LOCALFILE) (* ; "Edited 12-Feb-2022 18:06 by rmk")
(* ; "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?")
(* ;; "If GITFILE in (remote) BRANCH exists, it is copied to LOCALFILE and LOCALFILE 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)
(CL:WITH-OPEN-FILE (STREAM (OR LOCALFILE '{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))
(SETFILEINFO STREAM 'CREATIONDATE (OR (FILEDATE STREAM T)
(FILEDATE STREAM)
(GIT-FILE-DATE GITFILE BRANCH)))
STREAM))])
(GIT-FILE-EXISTS?
[LAMBDA (BRANCH GITFILE) (* ; "Edited 10-Dec-2021 21:30 by rmk")
[LAMBDA (BRANCH GITFILE) (* ; "Edited 10-Feb-2022 20:55 by rmk")
(* ; "Edited 10-Dec-2021 21:30 by rmk")
(* ;; "T if GITFILE exists on BRANCH")
(* ;; "T if GITFILE exists on BRANCH. If s is EOFP, the file exists but is empty")
(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 "'"])
(CL:WITH-OPEN-STREAM (s (CREATE-PROCESS-STREAM (CONCAT (CDGITDIR)
"git show " BRANCH ":" GITFILE)))
(SETFILEINFO s 'ENDOFSTREAMOP (FUNCTION NILL))
(NOT (FOR I C FROM 1 WHILE (SETQ C (NTHCHARCODE "fatal: path '" I))
ALWAYS (EQ (BIN s)
C])
(GIT-REMOTE-UPDATE
[LAMBDA (DOIT) (* ; "Edited 16-Dec-2021 10:45 by rmk")
@ -462,6 +500,14 @@
(PROG1 (GIT-COMMAND "git remote update origin")
(SETQ LAST-REMOTE-UPDATE-IDATE (IDATE))))])
(GIT-REMOTE-ADD
[LAMBDA (NAME URL) (* ; "Edited 31-Jan-2022 13:53 by rmk")
(LET [(RESULT (GIT-COMMAND (CONCAT "git remote add " NAME " " URL]
(* ;; "Does it return an error line? What if URL is not good? ")
(CAR RESULT])
(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%" "
@ -702,7 +748,8 @@
(DEFINEQ
(GIT-GET-DIFFERENT-FILES
[LAMBDA (BRANCH1 BRANCH2 DIR1 DIR2) (* ; "Edited 23-Jan-2022 21:45 by rmk")
[LAMBDA (BRANCH1 BRANCH2 DIR1 DIR2) (* ; "Edited 12-Feb-2022 18:35 by rmk")
(* ; "Edited 23-Jan-2022 21:45 by rmk")
(* ; "Edited 11-Jan-2022 11:03 by rmk")
(* ; "Edited 5-Jan-2022 08:01 by rmk")
@ -711,43 +758,36 @@
(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}<gitfiles>" DATE ">"))
(PSEUDOHOST 'FROMGIT (CONCAT "{CORE}<gitfiles>" (DATE)
">"))
(* ;; "UNSLASHIT because CORE doesn't know about slash")
(CL:UNLESS DIR1
(SETQ DIR1 (CONCAT "{FROMGIT}<" (UNSLASHIT BRANCH1)
(SETQ DIR1 (CONCAT "{FROMGIT}" (UNSLASHIT BRANCH1)
">")))
(CL:UNLESS DIR2
(SETQ DIR2 (CONCAT "{FROMGIT}<" (UNSLASHIT BRANCH2)
(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)))]
(FOR GFILE IN DIFFS DO (GIT-GET-FILE BRANCH1 GFILE (CONCAT DIR1 GFILE))
(GIT-GET-FILE MERGE GFILE (CONCAT DIR2 GFILE)))
(LIST DIR1 DIR2))])
(GIT-COMPARE-BRANCHES
[LAMBDA (BRANCH1 BRANCH2 LOCAL) (* ; "Edited 28-Jan-2022 23:58 by rmk")
(* ; "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")
[LAMBDA (BRANCH1 BRANCH2 LOCAL) (* ; "Edited 19-Feb-2022 10:21 by rmk")
(* ; "Edited 13-Feb-2022 21:27 by rmk")
(* ; "Edited 2-Feb-2022 08:46 by rmk")
(* ; "Edited 28-Jan-2022 23:58 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)
(LET (CDVALUE DIRS NENTRIES)
(PRINTOUT T "Fetching differences" T)
(SETQ DIRS (GIT-GET-DIFFERENT-FILES BRANCH1 BRANCH2))
(IF DIRS
@ -755,20 +795,32 @@
(SETQ CDVALUE (COMPAREDIRECTORIES (CAR DIRS)
(CADR DIRS)
'(> < ~= -* *-)
'*>*.*))
'*>*.*))
(* ;; "We know that both sides come from Unix/unversioned, even if they have been copied into versioned FROMGIT, so we make a pass to remove the misleading ;1's.")
(* ;;
 " Also, lower case the directories. Perhaps can be done when the files are fetched?")
[CDMAP CDVALUE (FUNCTION (LAMBDA (CDE)
(DECLARE (USEDFREE INFO1 INFO2))
(CL:WHEN INFO1
(CHANGE (FETCH (CDINFO FULLNAME) OF INFO1)
(SLASHIT (CL:IF
(STRPOS ";1" DATUM -2 NIL T)
(SUBSTRING DATUM 1 -3)
DATUM)
T)))
(CL:WHEN INFO2
(CHANGE (FETCH (CDINFO FULLNAME) OF INFO2)
(SLASHIT (CL:IF
(STRPOS ";1" DATUM -2 NIL T)
(SUBSTRING DATUM 1 -3)
DATUM)
T)))]
(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)))]
THEN (SETQ LAST-BRANCH-CDVALUE CDVALUE)
(CDBROWSER CDVALUE (CONCAT "Compare " BRANCH1 " and " BRANCH2 " "
(LENGTH (FETCH (CDVALUE CDENTRIES) OF CDVALUE))
" files")
@ -776,14 +828,18 @@
`(LABELFN GIT-CD-LABELFN BRANCH1 ,BRANCH1 BRANCH2 ,BRANCH2)
NIL
`(Compare See))
ELSE "NO DIFFERENCES")
ELSE "NO DIFFERENCES"])
(SETQ NENTRIES (LENGTH (FETCH (CDVALUE CDENTRIES) OF CDVALUE)))
(LIST NENTRIES (CL:IF (EQ NENTRIES 1)
'difference
'differences))
ELSE '(0 differences))
ELSE '(0 differences])
(GIT-COMPARE-WITH-MYMEDLEY
[LAMBDA (SUBDIRS SELECT EXCLUDEDFILES TEDIT FIXDIRECTORYDATES UPDATE)
[LAMBDA (SUBDIRS SELECT EXCLUDEDFILES TEDIT FIXDIRECTORYDATES UPDATE HOST1 HOST2)
(* ;;
 "Edited 28-Jan-2022 23:57 by rmk: my medley subdirectories with the current local git branch.")
 "Edited 19-Feb-2022 10:19 by rmk: my medley subdirectories with the current local git branch.")
(* ;; "Compares my medley subdirectories with the current local git branch.")
@ -794,13 +850,14 @@
(SETQ SUBDIRS (L-CASE SUBDIRS))
(PRINTOUT T "Comparing " (SELECTQ SUBDIRS
(nil (SETQ SUBDIRS '(sources library lispusers)))
(all (SETQ SUBDIRS MEDLEYSUBDIRS)
(all (SETQ SUBDIRS (ALLSUBDIRS HOST1 HOST2))
"ALL subdirectories")
SUBDIRS)
" of My Medley and "
(GIT-WHICH-BRANCH)
T)
(for SUBDIR TITLE CDVAL (BRANCH2 _ (GIT-WHICH-BRANCH)) INSIDE SUBDIRS
(for SUBDIR TITLE CDVAL (NENTRIES _ 0)
(BRANCH2 _ (GIT-WHICH-BRANCH)) INSIDE SUBDIRS
collect (TERPRI T)
(SETQ CDVAL (COMPAREDIRECTORIES (MEDLEYSUBDIR SUBDIR T)
(GITSUBDIR SUBDIR T)
@ -822,26 +879,27 @@
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 "" (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])
[for CDVAL TITLE IN $$VAL as SUBDIR inside SUBDIRS
do (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 "" Copy% <- (|Delete ALL <-| GIT-CD-MENUFN)
,@(CL:UNLESS (STRPOS "master" BRANCH2)
'("" Copy% -> (Delete% -> GIT-CD-MENUFN)))]
(CONS (CONCAT SUBDIR "/")
(for CDENTRY in (fetch CDENTRIES of CDVAL) collect (fetch MATCHNAME of CDENTRY)))
(ADD NENTRIES (LENGTH (FETCH (CDVALUE CDENTRIES) OF CDVAL]
(SETQ LAST-MYMEDLEY-CDVALUES $$VAL)
(TERPRI T)
(RETURN (LIST NENTRIES (CL:IF (EQ NENTRIES 1)
'difference
'differences)])
(GIT-COMPARE-WORKTREE
[LAMBDA (BRANCH DONTUPDATE) (* ; "Edited 25-Nov-2021 08:49 by rmk:")
@ -1004,8 +1062,9 @@
(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")
[LAMBDA (TBITEM MENUITEM CDBROWSER KEY) (* ; "Edited 5-Feb-2022 17:36 by rmk")
(* ; "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 <this function> . extrainfo). The selector for the selectq is either the CAR of the extrainfo or the display atom")
@ -1013,10 +1072,6 @@
(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")
@ -1058,14 +1113,15 @@
(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:")
[LAMBDA (GITCLONE) (* ; "Edited 5-Feb-2022 11:35 by rmk")
(* ; "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)
"; "])
(CONCAT "cd " (STRIPHOST (TRUEFILENAME (GIT-CLONEP GITCLONE)))
" ; "])
(GIT-COMMAND
[LAMBDA (CMD ALL NOERROR) (* ; "Edited 3-Jan-2022 10:47 by rmk")
@ -1118,20 +1174,22 @@
(ERROR "INITIALS is not set"])
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (4731 9857 (TOGIT 4741 . 6660) (FROMGIT 6662 . 7521) (GIT-DELETE-FILE 7523 . 8417) (
MYMEDLEY-DELETE-FILES 8419 . 9855)) (9858 11499 (MEDLEYSUBDIR 9868 . 10308) (GITSUBDIR 10310 . 10886)
(STRIPDIR 10888 . 11259) (STRIPHOST 11261 . 11497)) (11500 13437 (GFILE4MFILE 11510 . 12181) (
MFILE4GFILE 12183 . 12736) (GIT-REPO-FILENAME 12738 . 13435)) (13438 15772 (MEDLEYSUBDIRS 13448 .
14416) (GITSUBDIRS 14418 . 15770)) (15899 22393 (GIT-COMMIT 15909 . 16487) (GIT-PUSH 16489 . 17045) (
GIT-PULL 17047 . 17453) (GIT-BRANCH-DIFF 17455 . 18650) (GIT-APPROVAL 18652 . 18853) (GIT-GET-FILE
18855 . 19959) (GIT-FILE-EXISTS? 19961 . 20840) (GIT-REMOTE-UPDATE 20842 . 21884) (GIT-FILE-DATE 21886
. 22391)) (22438 26615 (GIT-CHECKOUT 22448 . 22689) (GIT-WHICH-BRANCH 22691 . 23275) (GIT-MAKE-BRANCH
23277 . 24768) (GIT-BRANCHES 24770 . 25550) (GIT-BRANCH-EXISTS? 25552 . 26613)) (26645 29350 (
GIT-MY-CURRENT-BRANCH 26655 . 26828) (GIT-MY-BRANCHP 26830 . 27749) (GIT-MY-NEXT-BRANCH 27751 . 28192)
(GIT-MY-BRANCHES 28194 . 29348)) (29396 33166 (GIT-ADD-WORKTREE 29406 . 31166) (GIT-REMOVE-WORKTREE
31168 . 31746) (GIT-LIST-WORKTREES 31748 . 32552) (WORKTREEDIR 32554 . 33164)) (33214 53766 (
GIT-GET-DIFFERENT-FILES 33224 . 35094) (GIT-COMPARE-BRANCHES 35096 . 38064) (GIT-COMPARE-WITH-MYMEDLEY
38066 . 41751) (GIT-COMPARE-WORKTREE 41753 . 45230) (GITCDOBJBUTTONFN 45232 . 50236) (GIT-CD-LABELFN
50238 . 51320) (GIT-CD-MENUFN 51322 . 53764)) (53812 56711 (CDGITDIR 53822 . 54254) (GIT-COMMAND 54256
. 55824) (GITORIGIN 55826 . 56403) (GIT-INITIALS 56405 . 56709)))))
(FILEMAP (NIL (3466 4312 (GIT-CLONEP 3476 . 4310)) (5552 7490 (ALLSUBDIRS 5562 . 6688) (MEDLEYSUBDIRS
6690 . 7129) (GITSUBDIRS 7131 . 7488)) (7491 12965 (TOGIT 7501 . 9649) (FROMGIT 9651 . 10629) (
GIT-DELETE-FILE 10631 . 11525) (MYMEDLEY-DELETE-FILES 11527 . 12963)) (12966 15362 (MEDLEYSUBDIR 12976
. 13416) (GITSUBDIR 13418 . 13994) (STRIPDIR 13996 . 14367) (STRIPHOST 14369 . 14605) (STRIPNAME
14607 . 15360)) (15363 16664 (GFILE4MFILE 15373 . 15619) (MFILE4GFILE 15621 . 15963) (
GIT-REPO-FILENAME 15965 . 16662)) (16713 23632 (GIT-COMMIT 16723 . 17301) (GIT-PUSH 17303 . 17859) (
GIT-PULL 17861 . 18267) (GIT-BRANCH-DIFF 18269 . 19464) (GIT-APPROVAL 19466 . 19667) (GIT-GET-FILE
19669 . 21044) (GIT-FILE-EXISTS? 21046 . 21770) (GIT-REMOTE-UPDATE 21772 . 22814) (GIT-REMOTE-ADD
22816 . 23123) (GIT-FILE-DATE 23125 . 23630)) (23677 27854 (GIT-CHECKOUT 23687 . 23928) (
GIT-WHICH-BRANCH 23930 . 24514) (GIT-MAKE-BRANCH 24516 . 26007) (GIT-BRANCHES 26009 . 26789) (
GIT-BRANCH-EXISTS? 26791 . 27852)) (27884 30589 (GIT-MY-CURRENT-BRANCH 27894 . 28067) (GIT-MY-BRANCHP
28069 . 28988) (GIT-MY-NEXT-BRANCH 28990 . 29431) (GIT-MY-BRANCHES 29433 . 30587)) (30635 34405 (
GIT-ADD-WORKTREE 30645 . 32405) (GIT-REMOVE-WORKTREE 32407 . 32985) (GIT-LIST-WORKTREES 32987 . 33791)
(WORKTREEDIR 33793 . 34403)) (34453 55532 (GIT-GET-DIFFERENT-FILES 34463 . 36052) (
GIT-COMPARE-BRANCHES 36054 . 39902) (GIT-COMPARE-WITH-MYMEDLEY 39904 . 43622) (GIT-COMPARE-WORKTREE
43624 . 47101) (GITCDOBJBUTTONFN 47103 . 52107) (GIT-CD-LABELFN 52109 . 53191) (GIT-CD-MENUFN 53193 .
55530)) (55578 58625 (CDGITDIR 55588 . 56168) (GIT-COMMAND 56170 . 57738) (GITORIGIN 57740 . 58317) (
GIT-INITIALS 58319 . 58623)))))
STOP

BIN
lispusers/GITFNS.LCOM
View File

Binary file not shown.

33
lispusers/PSEUDOHOSTS
View File

@ -1,14 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "30-Jan-2022 08:58:48" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>PSEUDOHOSTS.;135 25556
(FILECREATED " 5-Feb-2022 08:23:53" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>PSEUDOHOSTS.;136 25474
:CHANGES-TO (FNS PSEUDOHOST CONTRACT.PH EXPAND.PH PSEUDOFILENAME)
(RECORDS PHDEVICE TARGETDEVICE)
(VARS PSEUDOHOSTSCOMS)
:CHANGES-TO (FNS EXPAND.PH)
:PREVIOUS-DATE "28-Jan-2022 09:06:55"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>PSEUDOHOSTS.;123)
:PREVIOUS-DATE "30-Jan-2022 08:58:48"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>PSEUDOHOSTS.;135)
(PRETTYCOMPRINT PSEUDOHOSTSCOMS)
@ -172,7 +170,7 @@
(EXPAND.PH
[LAMBDA (FILENAME PHDEV)
(* ;; "Edited 30-Jan-2022 00:15 by rmk: that FILENAME contains }, because HOST was identified in it. If FILENAME is a stream, expand its full name")
(* ;; "Edited 5-Feb-2022 08:23 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")
@ -185,7 +183,8 @@
(IF (TYPE? PHDEVICE PHDEV)
THEN (LET (SUFFIX SUFFIXPOS)
(CL:WHEN (SETQ SUFFIXPOS (STRPOS "}" FILENAME))
(SETQ SUFFIX (SUBSTRING FILENAME (ADD1 SUFFIXPOS)))
(SETQ SUFFIX (OR (SUBSTRING FILENAME (ADD1 SUFFIXPOS))
""))
(CL:WHEN (FMEMB (CHCON1 SUFFIX)
(CHARCODE (< > /)))
(SETQ SUFFIX (SUBSTRING SUFFIX 2)))
@ -471,12 +470,12 @@
(LOAD 'EXPORTS.ALL))
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1355 8925 (PSEUDOHOST 1365 . 6625) (PSEUDOHOSTP 6627 . 6977) (PSEUDOHOSTS 6979 . 7336)
(TARGETHOST 7338 . 7612) (TRUEFILENAME 7614 . 8301) (PSEUDOFILENAME 8303 . 8923)) (8953 16177 (
EXPAND.PH 8963 . 10190) (CONTRACT.PH 10192 . 12857) (SLASHIT 12859 . 14427) (UNSLASHIT 14429 . 16175))
(16178 22968 (OPENFILE.PH 16188 . 16749) (GETFILENAME.PH 16751 . 17040) (DIRECTORYNAMEP.PH 17042 .
17666) (CLOSEFILE.PH 17668 . 18022) (REOPENFILE.PH 18024 . 18589) (DELETEFILE.PH 18591 . 18875) (
OPENP.PH 18877 . 19053) (UNREGISTERFILE.PH 19055 . 19360) (REGISTERFILE.PH 19362 . 19663) (
GENERATEFILES.PH 19665 . 20705) (GETFILEINFO.PH 20707 . 21009) (SETFILEINFO.PH 21011 . 21210) (
NEXTFILEFN.PH 21212 . 21754) (FILEINFOFN.PH 21756 . 22027) (RENAMEFILE.PH 22029 . 22966)))))
(FILEMAP (NIL (1226 8796 (PSEUDOHOST 1236 . 6496) (PSEUDOHOSTP 6498 . 6848) (PSEUDOHOSTS 6850 . 7207)
(TARGETHOST 7209 . 7483) (TRUEFILENAME 7485 . 8172) (PSEUDOFILENAME 8174 . 8794)) (8824 16095 (
EXPAND.PH 8834 . 10108) (CONTRACT.PH 10110 . 12775) (SLASHIT 12777 . 14345) (UNSLASHIT 14347 . 16093))
(16096 22886 (OPENFILE.PH 16106 . 16667) (GETFILENAME.PH 16669 . 16958) (DIRECTORYNAMEP.PH 16960 .
17584) (CLOSEFILE.PH 17586 . 17940) (REOPENFILE.PH 17942 . 18507) (DELETEFILE.PH 18509 . 18793) (
OPENP.PH 18795 . 18971) (UNREGISTERFILE.PH 18973 . 19278) (REGISTERFILE.PH 19280 . 19581) (
GENERATEFILES.PH 19583 . 20623) (GETFILEINFO.PH 20625 . 20927) (SETFILEINFO.PH 20929 . 21128) (
NEXTFILEFN.PH 21130 . 21672) (FILEINFOFN.PH 21674 . 21945) (RENAMEFILE.PH 21947 . 22884)))))
STOP

BIN
lispusers/PSEUDOHOSTS.LCOM
View File

Binary file not shown.

59
lispusers/comparetext
View File

@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "30-Jan-2022 09:03:52" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>comparetext.;112 47459
(FILECREATED "19-Feb-2022 12:01:45" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>comparetext.;115 46109
:CHANGES-TO (FNS COMPARETEXT.TEXTOBJ)
:CHANGES-TO (FNS COMPARETEXT.WINDOW)
:PREVIOUS-DATE "28-Jan-2022 17:12:30"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>comparetext.;110)
:PREVIOUS-DATE "18-Feb-2022 17:05:22"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>comparetext.;114)
(* ; "
@ -58,7 +58,9 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
HASH.TYPE REGION FILELABELS TITLE])
(COMPARETEXT.WINDOW
[LAMBDA (GRAPH REGION TITLE) (* ; "Edited 23-Jan-2022 18:18 by rmk")
[LAMBDA (GRAPH REGION TITLE) (* ; "Edited 19-Feb-2022 12:01 by rmk")
(* ; "Edited 2-Feb-2022 17:29 by rmk")
(* ; "Edited 23-Jan-2022 18:18 by rmk")
(* ; "Edited 12-Jan-2022 10:06 by rmk")
(* ; "Edited 22-Dec-2021 15:51 by rmk")
@ -87,13 +89,7 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
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")
(RELCREATEREGION WIDTH HEIGHT 'RIGHT 'TOP REGION)))
ELSE (RELCREATEREGION WIDTH HEIGHT 'RIGHT 'TOP REGION)))
[SETQ WINDOW (CREATEW REGION (OR TITLE (CONCAT "Compare text" (CL:IF FILEPREFIX
(CONCAT " of " FILEPREFIX)
"")
@ -111,26 +107,11 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
(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)
(CL:WHEN (AND (SETQ TOBJ (WINDOWPROP
W
'COL1TEXTOBJ))
(SETQ TWINDOW
(WFROMDS (TEXTSTREAM TOBJ)))
(OPENWP TWINDOW))
(CLOSEW TWINDOW))
(CL:WHEN (AND (SETQ TOBJ (WINDOWPROP
W
'COL2TEXTOBJ))
(SETQ TWINDOW
(WFROMDS (TEXTSTREAM TOBJ)))
(OPENWP TWINDOW))
(CLOSEW TWINDOW]
WINDOW])
(COMPARETEXT.TEXTOBJ
[LAMBDA (NODE WINDOW INCOL1) (* ; "Edited 30-Jan-2022 09:03 by rmk")
[LAMBDA (NODE WINDOW INCOL1) (* ; "Edited 18-Feb-2022 17:05 by rmk")
(* ; "Edited 30-Jan-2022 09:03 by rmk")
(* ; "Edited 28-Jan-2022 22:37 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.")
@ -149,7 +130,7 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
-1
1))
`(,WINDOW BOTTOM -2)
T))
NIL))
(SETQ REGION (CL:IF COMPARETEXT.AUTOTEDIT
(RELCREATEREGION REGIONARGS)
(RELGETREGION REGIONARGS)))
@ -755,12 +736,12 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
)
(PUTPROPS COMPARETEXT COPYRIGHT ("Xerox Corporation" 1984 1985 1993 1998))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1345 40079 (COMPARETEXT 1355 . 2855) (COMPARETEXT.WINDOW 2857 . 7675) (
COMPARETEXT.TEXTOBJ 7677 . 10274) (COMPARETEXT.SETSEL 10276 . 11066) (CHUNKNODELABEL 11068 . 12189) (
IMCOMPARE.BOXNODE 12191 . 12958) (IMCOMPARE.CHUNKS 12960 . 17336) (IMCOMPARE.COLLECT.HASH.CHUNKS 17338
. 20255) (IMCOMPARE.DISPLAYGRAPH 20257 . 28100) (IMCOMPARE.HASH 28102 . 32289) (
IMCOMPARE.MERGE.CONNECTED.CHUNKS 32291 . 35787) (IMCOMPARE.MERGE.UNCONNECTED.CHUNKS 35789 . 37744) (
IMCOMPARE.SHOW.DIST 37746 . 38192) (IMCOMPARE.UPDATE.SYMBOL.TABLE 38194 . 40077)) (40080 46237 (
IMCOMPARE.LEFTBUTTONFN 40090 . 42667) (IMCOMPARE.MIDDLEBUTTONFN 42669 . 45785) (IMCOMPARE.COPYBUTTONFN
45787 . 46235)) (46290 46981 (TAIL1 46300 . 46654) (TAIL2 46656 . 46979)))))
(FILEMAP (NIL (1344 38729 (COMPARETEXT 1354 . 2854) (COMPARETEXT.WINDOW 2856 . 6214) (
COMPARETEXT.TEXTOBJ 6216 . 8924) (COMPARETEXT.SETSEL 8926 . 9716) (CHUNKNODELABEL 9718 . 10839) (
IMCOMPARE.BOXNODE 10841 . 11608) (IMCOMPARE.CHUNKS 11610 . 15986) (IMCOMPARE.COLLECT.HASH.CHUNKS 15988
. 18905) (IMCOMPARE.DISPLAYGRAPH 18907 . 26750) (IMCOMPARE.HASH 26752 . 30939) (
IMCOMPARE.MERGE.CONNECTED.CHUNKS 30941 . 34437) (IMCOMPARE.MERGE.UNCONNECTED.CHUNKS 34439 . 36394) (
IMCOMPARE.SHOW.DIST 36396 . 36842) (IMCOMPARE.UPDATE.SYMBOL.TABLE 36844 . 38727)) (38730 44887 (
IMCOMPARE.LEFTBUTTONFN 38740 . 41317) (IMCOMPARE.MIDDLEBUTTONFN 41319 . 44435) (IMCOMPARE.COPYBUTTONFN
44437 . 44885)) (44940 45631 (TAIL1 44950 . 45304) (TAIL2 45306 . 45629)))))
STOP