diff --git a/library/UNIXUTILS b/library/UNIXUTILS index 9bb94cb98..28ffedcfe 100644 --- a/library/UNIXUTILS +++ b/library/UNIXUTILS @@ -1,11 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "13-Nov-2023 12:57:10" {DSK}frank>il>medley>gmedley>library>UNIXUTILS.;26 16663 +(FILECREATED "22-Oct-2025 13:05:51" {WMEDLEY}UNIXUTILS.;33 17919 - :CHANGES-TO (FNS ShellBrowser) + :EDIT-BY rmk - :PREVIOUS-DATE "11-Nov-2023 09:06:39" {DSK}frank>il>medley>gmedley>library>UNIXUTILS.;25 -) + :CHANGES-TO (FNS SLASHIT) + + :PREVIOUS-DATE "27-Sep-2025 16:25:07" {WMEDLEY}UNIXUTILS.;32) (PRETTYCOMPRINT UNIXUTILSCOMS) @@ -146,7 +147,8 @@ "true"]) (ShellOpen - [LAMBDA (FilenameOrURL) + [LAMBDA (FilenameOrURL) (* ; "Edited 10-Sep-2025 15:29 by rmk") + (* ; "Edited 4-May-2025 11:14 by rmk") (* ;; "Open the file or URL using the generic %"opener%" for this machine via a shell call.") @@ -176,62 +178,56 @@ " >>/tmp/ShellBrowser-warnings-$$.txt")) T) else (CONCAT "Unable to find a browser to open: " FilenameOrURL))) - else - (LET* - ((OPENER (ShellOpener)) - (FULLNAME (FULLNAME FilenameOrURL))) - (if (NOT FULLNAME) - then (CONCAT "File not found: " FilenameOrURL) - elseif (STREQUAL OPENER "true") - then (CONCAT "Unable to find a file opener to open: " FilenameOrURL) - else (LET* ((VERSION.SPECIFIED (FILENAMEFIELD FilenameOrURL 'VERSION)) - (UNPACKED (UNPACKFILENAME.STRING FULLNAME)) - (NEWNAME (CONCAT (LISTGET UNPACKED 'NAME) - "~" - (LISTGET UNPACKED 'VERSION) - "~")) - (EXTENSION (LISTGET UNPACKED 'EXTENSION)) - [UNVERSIONED (LET (FN (UNPACKED (COPY UNPACKED))) - (LISTPUT UNPACKED 'VERSION NIL) - (LISTPUT UNPACKED 'HOST NIL) - (SETQ FN (PACKFILENAME.STRING UNPACKED)) - (if (STREQUAL (SUBSTRING FN -1) - ".") - then (SETQ FN (SUBSTRING UNIXFILE 1 -2))) - (SETQ FN (SLASHIT FN] - (UNVERSIONED.EXISTS (INFILEP (CONCAT "{UNIX}" UNVERSIONED))) - (TMPDIR (CONCAT "/tmp/" (RAND 1000 9999))) - (TARGETFILE.LISP (PACKFILENAME.STRING 'HOST "{UNIX}" 'DIRECTORY TMPDIR - 'NAME NEWNAME 'EXTENSION EXTENSION)) - (TARGETFILE.UNIX (SLASHIT (PACKFILENAME.STRING 'HOST NIL 'DIRECTORY TMPDIR - 'NAME NEWNAME 'EXTENSION EXTENSION))) - (UNIXFILE NIL)) - (DECLARE (SPECVARS UNIXFILE)) - (if (OR VERSION.SPECIFIED (NOT UNVERSIONED.EXISTS)) - then (COPYFILE FULLNAME TARGETFILE.LISP) - (SETQ UNIXFILE TARGETFILE.UNIX) - else (SETQ UNIXFILE UNVERSIONED)) - (CL:WITH-OPEN-STREAM - (SHELLSTREAM (OPENSTREAM (CONCAT "{CORE}SHELLOUT" (RAND 1000 9999)) - 'BOTH)) - (ShellCommand (CONCAT OPENER " '" UNIXFILE "'" - " >>/tmp/ShellOpener-warnings-$$.txt") - SHELLSTREAM) - (if (EQ (GETFILEPTR SHELLSTREAM) - 0) - then T - else (LET* ((OUTSTRING (ALLOCSTRING (GETFILEPTR SHELLSTREAM) - " "))) - (CL:WITH-OPEN-STREAM (STRINGSTREAM (OPENSTRINGSTREAM OUTSTRING - 'OUTPUT)) - (SETFILEPTR SHELLSTREAM 0) - (CL:TAGBODY [SETFILEINFO SHELLSTREAM 'ENDOFSTREAMOP - #'(CL:LAMBDA (s) - (GO OUT] - (CL:LOOP (PRINTCCODE (READCCODE SHELLSTREAM) - STRINGSTREAM)) - OUT)) - OUTSTRING]) + else (LET* ((OPENER (ShellOpener)) + (FULLNAME (FULLNAME FilenameOrURL))) + (if (NOT FULLNAME) + then (CONCAT "File not found: " FilenameOrURL) + elseif (STREQUAL OPENER "true") + then (CONCAT "Unable to find a file opener to open: " FilenameOrURL) + else (LET* ((VERSION.SPECIFIED (FILENAMEFIELD FilenameOrURL 'VERSION)) + (UNPACKED (UNPACKFILENAME.STRING FULLNAME)) + (NEWNAME (CONCAT (LISTGET UNPACKED 'NAME) + "~" + (LISTGET UNPACKED 'VERSION) + "~")) + (EXTENSION (LISTGET UNPACKED 'EXTENSION)) + [UNVERSIONED (LET (FN (UNPACKED (COPY UNPACKED))) + (LISTPUT UNPACKED 'VERSION NIL) + (LISTPUT UNPACKED 'HOST NIL) + (SETQ FN (PACKFILENAME.STRING UNPACKED)) + (if (STREQUAL (SUBSTRING FN -1) + ".") + then (SETQ FN (SUBSTRING UNIXFILE 1 -2))) + (SETQ FN (SLASHIT FN] + (UNVERSIONED.EXISTS (INFILEP (CONCAT "{UNIX}" UNVERSIONED))) + (TMPDIR (CONCAT "/tmp/" (RAND 1000 9999))) + (TARGETFILE.LISP (PACKFILENAME.STRING 'HOST "{UNIX}" 'DIRECTORY TMPDIR + 'NAME NEWNAME 'EXTENSION EXTENSION)) + (TARGETFILE.UNIX (SLASHIT (PACKFILENAME.STRING 'HOST NIL 'DIRECTORY + TMPDIR 'NAME NEWNAME 'EXTENSION + EXTENSION))) + (UNIXFILE NIL)) + (DECLARE (SPECVARS UNIXFILE)) + (if (OR VERSION.SPECIFIED (NOT UNVERSIONED.EXISTS)) + then (COPYFILE FULLNAME TARGETFILE.LISP) + (SETQ UNIXFILE TARGETFILE.UNIX) + else (SETQ UNIXFILE UNVERSIONED)) + (CL:WITH-OPEN-STREAM + (SHELLSTREAM (OPENSTREAM (CONCAT "{CORE}SHELLOUT" (RAND 1000 9999)) + 'BOTH)) + (ShellCommand (CONCAT OPENER " '" UNIXFILE "'" + " >>/tmp/ShellOpener-warnings-$$.txt") + SHELLSTREAM) + (if (EQ (GETFILEPTR SHELLSTREAM) + 0) + then T + else (LET ((OUTSTRING (ALLOCSTRING (GETFILEPTR SHELLSTREAM) + " "))) + (CL:WITH-OPEN-STREAM (STRINGSTREAM (OPENSTRINGSTREAM + OUTSTRING + 'OUTPUT)) + (COPYCHARS SHELLSTREAM STRINGSTREAM 0 -1)) + OUTSTRING]) (PROCESS-COMMAND [LAMBDA (CMD) (* ; "Edited 17-Jul-2022 08:17 by rmk") @@ -244,7 +240,9 @@ 0))) DO (BLOCK) FINALLY (RETURN CODE]) (SLASHIT - [LAMBDA (X LCASEDIRS NOHOST) (* ; "Edited 23-Sep-2023 15:27 by rmk") + [LAMBDA (X LCASEDIRS NOHOST) (* ; "Edited 22-Oct-2025 13:05 by rmk") + (* ; "Edited 25-Sep-2025 09:57 by rmk") + (* ; "Edited 23-Sep-2023 15:27 by rmk") (* ;; "It would also be nice to use the generic unpackfilename/packfilename tools. But packfilename sticks in brackets again, and sticks a dot on when removing the version.") @@ -255,13 +253,14 @@ (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] + join (SELCHARQ C + ((< >) + (SETQ LASTDIRPOS I) + (CONS (CHARCODE /))) + (/ (SETQ LASTDIRPOS I) + (CONS C)) + (SPACE (CHARCODE (\ SPACE))) + (CONS C] (CL:WHEN (AND LCASEDIRS LASTDIRPOS) (SETQ LASTDIRPOS (ADD1 (IDIFFERENCE LASTDIRPOS DIRPOS))) (SETQ SLASHED (CONCAT (L-CASE (SUBSTRING SLASHED 1 LASTDIRPOS)) @@ -274,13 +273,15 @@ SLASHED))]) (UNIX-FILE-NAME - [LAMBDA (FILE ACCESS COPY) (* ; "Edited 1-Oct-2023 20:52 by rmk") + [LAMBDA (FILE ACCESS COPY) (* ; "Edited 27-Sep-2025 16:24 by rmk") + (* ; "Edited 19-Sep-2025 07:29 by rmk") + (* ; "Edited 13-Sep-2025 18:37 by rmk") + (* ; "Edited 1-Oct-2023 20:52 by rmk") - (* ;; "Tries to return the string that would reference FILE in a Unix shell, for the use of PROCESS-COMMAND and ShellCommand. If VERSION is 1, it assumes that the Unix file is doesn't have the Medley version convention. If FILE does not have a corresponding Unix name, COPY is non-NIL, and ACCESS is INPUT, FILE will be copied to a unix tmp file (with COPY in its name) and that name will be returned.") + (* ;; "Forces an extension %"ufn%" if there isn't one already, to avoid the dot/no-dot question") - (CL:WHEN (\GETSTREAM FILE ACCESS T) - (SETQ FILE (OR (FULLNAME FILE) - FILE))) (* ; "Might catch NODIRCORE") + (* ;; "Tries to return the string that would reference FILE in a Unix shell, for the use of PROCESS-COMMAND and ShellCommand. If VERSION is 1, it assumes that the Unix file is doesn't have the Medley version convention. If FILE does not have a corresponding Unix name, COPY is non-NIL, and ACCESS is INPUT, FILE will be copied to a unix tmp file (with COPY in its name) and that name will be returned.") + (* ; "Might catch NODIRCORE") (CL:WHEN FILE (SETQ FILE (TRUEFILENAME FILE)) (CL:UNLESS (STREAMP FILE) @@ -290,35 +291,42 @@ (NIL (SETQ ACCESS 'INPUT) 'OLD) (\ILLEGAL.ARG ACCESS]) - [SELECTQ (FILENAMEFIELD FILE 'HOST) - (UNIX [SUBSTRING FILE (ADD1 (CONSTANT (NCHARS "{UNIX}"]) - (DSK (LET [(VERSION (FILENAMEFIELD FILE 'VERSION] - (SETQ FILE (SLASHIT (PACKFILENAME 'HOST NIL 'VERSION NIL 'BODY FILE))) - (CL:IF (AND VERSION (IGREATERP VERSION 1)) - (CONCAT FILE (CL:IF (FILENAMEFIELD FILE 'EXTENSION) - "." - "") - "~" VERSION "~") - FILE))) - (CL:WHEN (AND COPY (EQ ACCESS 'INPUT) - FILE) - (RESETLST - (CL:WHEN (\GETSTREAM FILE 'INPUT T) (* ; "Hope is randaccess") - [RESETSAVE (GETFILEPTR FILE) - `(PROGN (SETFILEPTR ,FILE OLDVALUE]) - (COPYFILE FILE (CONCAT "{UNIX}/tmp/medley-" (L-CASE COPY) - "-" - (IDATE) - "-" - (RAND) - (CL:IF (FILENAMEFIELD FILE 'EXTENSION) - (CONCAT "." (FILENAMEFIELD FILE 'EXTENSION)) - "")))))])]) + (LET (UNAME VERSION) + [SELECTQ (FILENAMEFIELD FILE 'HOST) + ((UNIX DSK) + (SETQ UNAME FILE)) + (PROGN + (* ;; "Catch the streams as well as other devices (CORE, servers)") + + [SETQ UNAME (OUTFILEP (CONCAT "{DSK}/tmp/medley-" (CL:IF COPY + (CONCAT (L-CASE COPY) + "-") + "") + (IDATE] + (CL:WHEN (AND COPY FILE) + (RESETLST + (CL:WHEN (\GETSTREAM FILE 'INPUT T) + (* ; "Hope it's randaccess") + [RESETSAVE (GETFILEPTR FILE) + `(PROGN (SETFILEPTR ,FILE OLDVALUE]) + + (* ;; "Let DSK pick a new version number, rather than RAND") + + (COPYFILE FILE UNAME)))] + (SETQ VERSION (FILENAMEFIELD UNAME 'VERSION)) (* ; "Convert to Unix version. ") + (SETQ UNAME (PACKFILENAME 'VERSION NIL 'BODY UNAME)) + (CL:WHEN (AND VERSION (IGREATERP VERSION 1)) + (SETQ UNAME (CONCAT UNAME ".~" VERSION "~"))) + (SETQ UNAME (SLASHIT UNAME NIL T)) + (CL:IF (EQ (CHARCODE %.) + (NTHCHARCODE UNAME -1)) + (SUBSTRING UNAME 1 -2) + UNAME)))]) ) (PUTPROPS UNIXUTILS FILETYPE CL:COMPILE-FILE) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1146 1519 (ShellCommand 1146 . 1519)) (1521 1918 (ShellWhich 1521 . 1918)) (2008 16585 -(ShellBrowser 2018 . 3790) (ShellBrowse 3792 . 4477) (ShellOpener 4479 . 6167) (ShellOpen 6169 . 11324 -) (PROCESS-COMMAND 11326 . 11939) (SLASHIT 11941 . 13983) (UNIX-FILE-NAME 13985 . 16583))))) + (FILEMAP (NIL (1110 1483 (ShellCommand 1110 . 1483)) (1485 1882 (ShellWhich 1485 . 1882)) (1972 17841 +(ShellBrowser 1982 . 3754) (ShellBrowse 3756 . 4441) (ShellOpener 4443 . 6131) (ShellOpen 6133 . 11612 +) (PROCESS-COMMAND 11614 . 12227) (SLASHIT 12229 . 14566) (UNIX-FILE-NAME 14568 . 17839))))) STOP diff --git a/library/UNIXUTILS.DFASL b/library/UNIXUTILS.DFASL index 8a0089552..8dd244439 100644 Binary files a/library/UNIXUTILS.DFASL and b/library/UNIXUTILS.DFASL differ diff --git a/lispusers/COMPAREDIRECTORIES b/lispusers/COMPAREDIRECTORIES index 57e7feeaf..cfe48dc53 100644 --- a/lispusers/COMPAREDIRECTORIES +++ b/lispusers/COMPAREDIRECTORIES @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "24-Aug-2025 13:38:35" {WMEDLEY}COMPAREDIRECTORIES.;268 133743 +(FILECREATED "25-Oct-2025 23:59:24" {MEDLEY}COMPAREDIRECTORIES.;2 135376 :EDIT-BY rmk - :CHANGES-TO (FNS CDENTRIES.SELECT CDPRINT.LINE) + :CHANGES-TO (FNS CDBROWSER-COPY) - :PREVIOUS-DATE "26-Mar-2025 09:41:31" {WMEDLEY}COMPAREDIRECTORIES.;267) + :PREVIOUS-DATE "22-Oct-2025 08:32:01" {WMEDLEY}COMPAREDIRECTORIES.;272) (PRETTYCOMPRINT COMPAREDIRECTORIESCOMS) @@ -160,6 +160,8 @@ (COMPAREDIRECTORIES.INFOS [LAMBDA (DIR INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH USEDIRECTORYDATE INCLUDEAUTHOR) + (* ;; "Edited 21-Oct-2025 14:26 by rmk") + (* ;; "Edited 29-Sep-2023 17:25 by rmk") (* ;; "Edited 22-May-2022 14:17 by rmk") @@ -168,43 +170,45 @@ (* ;; "Each entry is a list of the form (matchname . CDINFOS). CDINFOS is guaranteed to be a singleton, unless ALLVERSIONS. ") - (FOR FULLNAME TYPE LDATE STREAM (STARTPOS _ (ADD1 (NCHARS DIR))) - IN (CDFILES DIR INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH) - COLLECT + (CL:WHEN (DIRECTORYNAMEP DIR) + [FOR FULLNAME TYPE LDATE STREAM (STARTPOS _ (ADD1 (NCHARS DIR))) + IN (CDFILES DIR INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH) + COLLECT - (* ;; "GDATE/IDATE in case Y2K") + (* ;; "GDATE/IDATE in case Y2K") - (SETQ STREAM (OPENSTREAM FULLNAME 'INPUT)) (* ; + (SETQ STREAM (OPENSTREAM FULLNAME 'INPUT)) (* ;  "So all the GETFILEINFO's, FILEDATES, etc. don't have to do the directory searching.") (* ;  "Is it a Lisp file? Get it's internal filecreated date. ") - (CL:MULTIPLE-VALUE-SETQ (TYPE LDATE) - (COMPAREDIRECTORIES.INFOS.TYPE STREAM)) - (PROG1 (LIST (MATCHNAME FULLNAME STARTPOS) - (CREATE CDINFO - FULLNAME _ (FULLNAME STREAM) - DATE _ (GDATE (IDATE (IF (OR USEDIRECTORYDATE (NULL LDATE)) - THEN (GETFILEINFO STREAM 'CREATIONDATE) - ELSE (SETFILEINFO STREAM 'CREATIONDATE LDATE) - LDATE))) - LENGTH _ (GETFILEINFO STREAM 'LENGTH) - AUTHOR _ (AND INCLUDEAUTHOR (GETFILEINFO STREAM 'AUTHOR)) - TYPE _ TYPE - EOL _ (EOLTYPE STREAM))) - (CLOSEF? STREAM)) - FINALLY - - (* ;; "Sort to get all entries with the same matchname adjacent. Presumably we would only need to collect multiples if ALLVERSIONS, but in a case-sensitive file system we might see files with names that differ in case. We have deliberately given them a case-insensitive matchname, so we can expose this issue in the display.") - - (* ;; "If we see (MN X)(MN Y), smash the Y in after the X") - - (RETURN (FOR ITAIL I VAL MN ON (SORT $$VAL T) - DO (SETQ I (CAR ITAIL)) - (SETQ MN (CAR I)) - [WHILE (EQ MN (CAADR ITAIL)) DO (POP ITAIL) - (PUSH (CDR I) - (CADR (CAR ITAIL] - (PUSH VAL I) FINALLY (RETURN (DREVERSE VAL]) + (CL:MULTIPLE-VALUE-SETQ (TYPE LDATE) + (COMPAREDIRECTORIES.INFOS.TYPE STREAM)) + (PROG1 (LIST (MATCHNAME FULLNAME STARTPOS) + (CREATE CDINFO + FULLNAME _ (FULLNAME STREAM) + DATE _ (GDATE (IDATE (IF (OR USEDIRECTORYDATE (NULL LDATE)) + THEN (GETFILEINFO STREAM 'CREATIONDATE) + ELSE (SETFILEINFO STREAM 'CREATIONDATE + LDATE) + LDATE))) + LENGTH _ (GETFILEINFO STREAM 'LENGTH) + AUTHOR _ (AND INCLUDEAUTHOR (GETFILEINFO STREAM 'AUTHOR)) + TYPE _ TYPE + EOL _ (EOLTYPE STREAM))) + (CLOSEF? STREAM)) + FINALLY + + (* ;; "Sort to get all entries with the same matchname adjacent. Presumably we would only need to collect multiples if ALLVERSIONS, but in a case-sensitive file system we might see files with names that differ in case. We have deliberately given them a case-insensitive matchname, so we can expose this issue in the display.") + + (* ;; "If we see (MN X)(MN Y), smash the Y in after the X") + + (RETURN (FOR ITAIL I VAL MN ON (SORT $$VAL T) + DO (SETQ I (CAR ITAIL)) + (SETQ MN (CAR I)) + [WHILE (EQ MN (CAADR ITAIL)) DO (POP ITAIL) + (PUSH (CDR I) + (CADR (CAR ITAIL] + (PUSH VAL I) FINALLY (RETURN (DREVERSE VAL])]) (COMPAREDIRECTORIES.CANDIDATES [LAMBDA (INFOS1 INFOS2) @@ -335,7 +339,9 @@ CDE]) (COMPAREDIRECTORIES.INFOS.TYPE - [LAMBDA (FILE) (* ; "Edited 28-Sep-2023 23:09 by rmk") + [LAMBDA (FILE) (* ; "Edited 22-Oct-2025 08:29 by rmk") + (* ; "Edited 20-Sep-2025 12:59 by rmk") + (* ; "Edited 28-Sep-2023 23:09 by rmk") (* ; "Edited 22-May-2022 14:27 by rmk") (* ; "Edited 25-Apr-2022 09:02 by rmk") (* ; "Edited 4-Jan-2022 13:10 by rmk") @@ -404,7 +410,8 @@ (DEFINEQ (CDFILES - [LAMBDA (DIR INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH)(* ; "Edited 17-Jun-2023 23:04 by rmk") + [LAMBDA (DIR INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH)(* ; "Edited 20-Oct-2025 23:25 by rmk") + (* ; "Edited 17-Jun-2023 23:04 by rmk") (* ; "Edited 3-Oct-2022 12:03 by rmk") (* ; "Edited 25-Apr-2022 08:42 by rmk") (* ; "Edited 5-Mar-2022 15:05 by rmk") @@ -426,8 +433,7 @@ (* ;; "EXCLUDEDFILES is a filepattern with * meaning everything, COM means *.LCOM and *.DFASL") - [SETQ EXCLUDEDFILES `(*>.DS_Store - ,@(MKLIST EXCLUDEDFILES] + [SETQ EXCLUDEDFILES `(*>.DS¬Store ,@(MKLIST EXCLUDEDFILES] (CL:UNLESS (EQMEMB '.* INCLUDEDFILES) (* ;  "Excluded dot files unless specifically asked for") [SETQ EXCLUDEDFILES `(.* ,@(MKLIST EXCLUDEDFILES]) @@ -2117,13 +2123,17 @@ NIL]) (CDBROWSER-COPY - [LAMBDA (CDBROWSER TBITEM SOURCE) (* ; "Edited 24-May-2022 15:49 by rmk") + [LAMBDA (CDBROWSER TBITEM SOURCE UNIXDEST) (* ; "Edited 25-Oct-2025 23:58 by rmk") + (* ; "Edited 24-May-2022 15:49 by rmk") (* ; "Edited 25-Apr-2022 09:24 by rmk") (* ; "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.") + (* ;; + "if UNIXDEST, coerces the true destination file to host UNIX--suppresses Medley version numbers") + (* ;; "Returns NIL if the copy fails.") (CL:UNLESS (TB.ITEM.DELETED? CDBROWSER TBITEM) @@ -2167,7 +2177,17 @@ (CLEARW T) (CL:UNLESS DESTFILE (SETQ DESTFILE (CD-SWAPDIRS SOURCEFILE SOURCEDIR DESTDIR))) - (SETQ RESULT (COPYFILE SOURCEFILE (PACKFILENAME.STRING 'VERSION NIL 'BODY DESTFILE))) + [SETQ RESULT (if UNIXDEST + then [PSEUDOFILENAME (PACKFILENAME 'HOST 'DSK 'BODY + (COPYFILE SOURCEFILE (PACKFILENAME + 'HOST + 'UNIX + 'VERSION NIL + 'BODY + (TRUEFILENAME + DESTFILE] + else (COPYFILE SOURCEFILE (PACKFILENAME.STRING 'VERSION NIL + 'BODY DESTFILE] (PRIN3 (IF RESULT THEN (TB.DELETE.ITEM CDBROWSER TBITEM) (CONCAT "Copied to " RESULT) @@ -2251,25 +2271,25 @@ (MOVD? 'NILL 'TEDIT.FILEDATE) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2673 23163 (COMPAREDIRECTORIES 2683 . 8018) (COMPAREDIRECTORIES.INFOS 8020 . 10978) ( -COMPAREDIRECTORIES.CANDIDATES 10980 . 14365) (CDENTRIES.SELECT 14367 . 19269) ( -COMPAREDIRECTORIES.INFOS.TYPE 19271 . 20397) (MATCHNAME 20399 . 21079) (CD.INSURECDVALUE 21081 . 22695 -) (CD.UPDATEWIDTHS 22697 . 23161)) (23164 33786 (CDFILES 23174 . 29188) (CDFILES.MATCH 29190 . 30815) -(CDFILES.PATS 30817 . 33784)) (33787 51805 (CDPRINT 33797 . 36314) (CDPRINT.HEADER 36316 . 37213) ( -CDPRINT.LINE 37215 . 40644) (CDPRINT.MAXWIDTHS 40646 . 44761) (CDPRINT.COLHEADERS 44763 . 46048) ( -CDPRINT.COLUMNS 46050 . 51170) (CDTEDIT 51172 . 51803)) (51806 60927 (CDMAP 51816 . 53248) (CDENTRY -53250 . 53559) (CDSUBSET 53561 . 55000) (CDMERGE 55002 . 58986) (CDMERGE.COMMON 58988 . 60303) ( -CD.SORT 60305 . 60925)) (60928 68466 (BINCOMP 60938 . 65227) (EOLTYPE 65229 . 67791) (EOLTYPE.SHOW -67793 . 68464)) (68994 81521 (FIND-UNCOMPILED-FILES 69004 . 72647) (FIND-UNSOURCED-FILES 72649 . 75033 -) (FIND-SOURCE-FILES 75035 . 76773) (FIND-COMPILED-FILES 76775 . 78652) (FIND-UNLOADED-FILES 78654 . -79507) (FIND-LOADED-FILES 79509 . 79937) (FIND-MULTICOMPILED-FILES 79939 . 81519)) (81522 89953 ( -CREATED-AS 81532 . 86329) (SOURCE-FOR-COMPILED-P 86331 . 89258) (COMPILE-SOURCE-DATE-DIFF 89260 . -89951)) (89954 100717 (FIX-DIRECTORY-DATES 89964 . 93414) (FIX-EQUIV-DATES 93416 . 94941) ( -COPY-COMPARED-FILES 94943 . 96764) (COPY-MISSING-FILES 96766 . 98923) (COMPILED-ON-SAME-SOURCE 98925 - . 100715)) (100911 108749 (CDBROWSER 100921 . 104848) (CDBROWSER.STRINGS 104850 . 108747)) (108911 -110647 (CD.TABLEITEM 108921 . 109141) (CD.TABLEITEM.PRINTFN 109143 . 109342) (CD.TABLEITEM.COPYFN -109344 . 110402) (CDTABLEBROWSER.HEADING.REPAINTFN 110404 . 110645)) (110648 133218 ( -CDTABLEBROWSER.WHENSELECTEDFN 110658 . 111126) (CD.COMMANDSELECTEDFN 111128 . 116229) (CD-MENUFN -116231 . 122457) (CD-COMPARE-FILES 122459 . 125811) (CDBROWSER-COPY 125813 . 129482) ( -CDBROWSER-DELETE-FILE 129484 . 132697) (CD-SWAPDIRS 132699 . 133216))))) + (FILEMAP (NIL (2655 23634 (COMPAREDIRECTORIES 2665 . 8000) (COMPAREDIRECTORIES.INFOS 8002 . 11231) ( +COMPAREDIRECTORIES.CANDIDATES 11233 . 14618) (CDENTRIES.SELECT 14620 . 19522) ( +COMPAREDIRECTORIES.INFOS.TYPE 19524 . 20868) (MATCHNAME 20870 . 21550) (CD.INSURECDVALUE 21552 . 23166 +) (CD.UPDATEWIDTHS 23168 . 23632)) (23635 34340 (CDFILES 23645 . 29742) (CDFILES.MATCH 29744 . 31369) +(CDFILES.PATS 31371 . 34338)) (34341 52359 (CDPRINT 34351 . 36868) (CDPRINT.HEADER 36870 . 37767) ( +CDPRINT.LINE 37769 . 41198) (CDPRINT.MAXWIDTHS 41200 . 45315) (CDPRINT.COLHEADERS 45317 . 46602) ( +CDPRINT.COLUMNS 46604 . 51724) (CDTEDIT 51726 . 52357)) (52360 61481 (CDMAP 52370 . 53802) (CDENTRY +53804 . 54113) (CDSUBSET 54115 . 55554) (CDMERGE 55556 . 59540) (CDMERGE.COMMON 59542 . 60857) ( +CD.SORT 60859 . 61479)) (61482 69020 (BINCOMP 61492 . 65781) (EOLTYPE 65783 . 68345) (EOLTYPE.SHOW +68347 . 69018)) (69548 82075 (FIND-UNCOMPILED-FILES 69558 . 73201) (FIND-UNSOURCED-FILES 73203 . 75587 +) (FIND-SOURCE-FILES 75589 . 77327) (FIND-COMPILED-FILES 77329 . 79206) (FIND-UNLOADED-FILES 79208 . +80061) (FIND-LOADED-FILES 80063 . 80491) (FIND-MULTICOMPILED-FILES 80493 . 82073)) (82076 90507 ( +CREATED-AS 82086 . 86883) (SOURCE-FOR-COMPILED-P 86885 . 89812) (COMPILE-SOURCE-DATE-DIFF 89814 . +90505)) (90508 101271 (FIX-DIRECTORY-DATES 90518 . 93968) (FIX-EQUIV-DATES 93970 . 95495) ( +COPY-COMPARED-FILES 95497 . 97318) (COPY-MISSING-FILES 97320 . 99477) (COMPILED-ON-SAME-SOURCE 99479 + . 101269)) (101465 109303 (CDBROWSER 101475 . 105402) (CDBROWSER.STRINGS 105404 . 109301)) (109465 +111201 (CD.TABLEITEM 109475 . 109695) (CD.TABLEITEM.PRINTFN 109697 . 109896) (CD.TABLEITEM.COPYFN +109898 . 110956) (CDTABLEBROWSER.HEADING.REPAINTFN 110958 . 111199)) (111202 134851 ( +CDTABLEBROWSER.WHENSELECTEDFN 111212 . 111680) (CD.COMMANDSELECTEDFN 111682 . 116783) (CD-MENUFN +116785 . 123011) (CD-COMPARE-FILES 123013 . 126365) (CDBROWSER-COPY 126367 . 131115) ( +CDBROWSER-DELETE-FILE 131117 . 134330) (CD-SWAPDIRS 134332 . 134849))))) STOP diff --git a/lispusers/COMPAREDIRECTORIES.LCOM b/lispusers/COMPAREDIRECTORIES.LCOM index 3a75fdb01..0fb8ccd94 100644 Binary files a/lispusers/COMPAREDIRECTORIES.LCOM and b/lispusers/COMPAREDIRECTORIES.LCOM differ diff --git a/lispusers/EXAMINEDEFS b/lispusers/EXAMINEDEFS index 4b1a111f8..0ec8b9738 100644 --- a/lispusers/EXAMINEDEFS +++ b/lispusers/EXAMINEDEFS @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 6-Apr-2025 23:54:50" {WMEDLEY}EXAMINEDEFS.;57 16827 +(FILECREATED "25-Oct-2025 10:24:30" {WMEDLEY}EXAMINEDEFS.;59 17123 :EDIT-BY rmk - :CHANGES-TO (FNS TEDITDEF) + :CHANGES-TO (FNS EXAMINEDEFS) - :PREVIOUS-DATE "31-Mar-2025 13:53:38" {WMEDLEY}EXAMINEDEFS.;56) + :PREVIOUS-DATE " 6-Apr-2025 23:54:50" {WMEDLEY}EXAMINEDEFS.;57) (PRETTYCOMPRINT EXAMINEDEFSCOMS) @@ -20,7 +20,8 @@ (DEFINEQ (EXAMINEDEFS - [LAMBDA (NAME TYPE SOURCE1 SOURCE2 TITLE1 TITLE2 REGION) (* ; "Edited 31-Mar-2025 13:53 by rmk") + [LAMBDA (NAME TYPE SOURCE1 SOURCE2 TITLE1 TITLE2 REGION) (* ; "Edited 25-Oct-2025 10:24 by rmk") + (* ; "Edited 31-Mar-2025 13:53 by rmk") (* ; "Edited 18-Feb-2025 22:56 by rmk") (* ; "Edited 6-Dec-2024 20:51 by rmk") (* ; "Edited 13-Oct-2023 11:11 by rmk") @@ -148,6 +149,8 @@ DEFAULTFONT))) (TEXTHEIGHT 600)) (DECLARE (SPECVARS COMPARETEXT.ALLCHUNKS)) + (SETQ TITLE1 (CONCAT NAME " from " TITLE1)) + (SETQ TITLE2 (CONCAT NAME " from " TITLE2)) (* ;  "Reuse an existing CT graph window for this DEF") (OR [FIND W IN (OPENWINDOWS) @@ -281,6 +284,6 @@ (FILESLOAD (SYSLOAD) COMPARETEXT VERSIONDEFS) (DECLARE%: DONTCOPY - (FILEMAP (NIL (662 16596 (EXAMINEDEFS 672 . 10994) (EXAMINEFILES 10996 . 12478) (TEDITDEF 12480 . -14802) (EXVV 14804 . 16594))))) + (FILEMAP (NIL (665 16892 (EXAMINEDEFS 675 . 11290) (EXAMINEFILES 11292 . 12774) (TEDITDEF 12776 . +15098) (EXVV 15100 . 16890))))) STOP diff --git a/lispusers/EXAMINEDEFS.LCOM b/lispusers/EXAMINEDEFS.LCOM index 5e21927cd..4db3ff8c8 100644 Binary files a/lispusers/EXAMINEDEFS.LCOM and b/lispusers/EXAMINEDEFS.LCOM differ diff --git a/lispusers/GITFNS b/lispusers/GITFNS index aed605330..015d1e521 100644 --- a/lispusers/GITFNS +++ b/lispusers/GITFNS @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "23-Sep-2025 21:43:21" {WMEDLEY}GITFNS.;551 134847 +(FILECREATED "26-Oct-2025 00:01:44" {WMEDLEY}GITFNS.;565 135222 :EDIT-BY rmk - :CHANGES-TO (FNS GIT-GET-DIFFERENT-FILES) + :CHANGES-TO (FNS GIT-WORKING-COMPARE-DIRECTORIES GIT-CD-MENUFN GIT-MAKE-PROJECT GIT-CLONEP) - :PREVIOUS-DATE "22-Sep-2025 12:52:41" {WMEDLEY}GITFNS.;550) + :PREVIOUS-DATE "25-Oct-2025 10:37:40" {WMEDLEY}GITFNS.;562) (PRETTYCOMPRINT GITFNSCOMS) @@ -135,22 +135,22 @@ (DEFINEQ (GIT-CLONEP - [LAMBDA (HOST/DIR NOERROR CHECKANCESTORS) (* ; "Edited 1-Oct-2023 18:09 by rmk") + [LAMBDA (HOST/DIR NOERROR CHECKANCESTORS) (* ; "Edited 25-Oct-2025 15:13 by rmk") + (* ; "Edited 14-Oct-2025 11:55 by rmk") + (* ; "Edited 1-Oct-2023 18:09 by rmk") (* ; "Edited 12-May-2022 11:44 by rmk") (* ; "Edited 8-May-2022 16:24 by rmk") - (* ;; "If CHECKANCESTORS, looks back up the directory chain to see if perhaps the .git is somewhere higher up.") - - (IF [AND HOST/DIR (LET [(D (SLASHIT (TRUEFILENAME (PACKFILENAME.STRING 'BODY HOST/DIR - 'HOST - 'DSK] - (IF (DIRECTORYNAMEP (CONCAT D "/.git/")) - THEN D - ELSEIF (AND CHECKANCESTORS (FIND-ANCESTOR-DIRECTORY - D - (FUNCTION (LAMBDA (A) - (DIRECTORYNAMEP (CONCAT A - ".git/"] + (* ;; "If CHECKANCESTORS, looks back up the directory chain to see if perhaps the .git is somewhere higher up. Returns the full true directory name") + + (IF (AND HOST/DIR (LET [(D (SLASHIT (TRUEFILENAME HOST/DIR] + (CL:WHEN [OR (DIRECTORYNAMEP (CONCAT D "/.git/")) + (SETQ D (AND CHECKANCESTORS + (FIND-ANCESTOR-DIRECTORY D + (FUNCTION (LAMBDA (A) + (DIRECTORYNAMEP (CONCAT + A ".git/"] + D))) ELSEIF NOERROR THEN NIL ELSE (ERROR "NOT A GIT CLONE" HOST/DIR]) @@ -169,6 +169,10 @@ (GIT-MAKE-PROJECT [LAMBDA (PROJECTNAME CLONEPATH WORKINGPATH EXCLUSIONS DEFAULTSUBDIRS) + (* ; "Edited 25-Oct-2025 16:53 by rmk") + (* ; "Edited 22-Oct-2025 12:45 by rmk") + (* ; "Edited 20-Oct-2025 18:10 by rmk") + (* ; "Edited 14-Oct-2025 11:51 by rmk") (* ; "Edited 1-Oct-2023 19:33 by rmk") (* ; "Edited 30-Mar-2023 09:06 by rmk") (* ; "Edited 5-Feb-2023 12:43 by rmk") @@ -222,19 +226,14 @@ (ERROR (CONCAT "Can't find a clone directory for " PROJECTNAME)) (PRINTOUT T "Note: Can't find a clone directory for " PROJECTNAME T))) - elseif (GIT-CLONEP [SLASHIT (PACKFILENAME 'HOST 'DSK 'DIRECTORY - (UNPACKFILENAME.STRING (TRUEFILENAME - CLONEPATH) - 'DIRECTORY - 'RETURN] - T T) + elseif (GIT-CLONEP CLONEPATH T T) else (ERROR (CONCAT "Can't find the clone directory " CLONEPATH " for " PROJECTNAME] (CL:WHEN CLONEPATH (LET (GITIGNORE PROJECT WP) (CL:WHEN (SETQ GITIGNORE (INFILEP (PACKFILENAME.STRING 'NAME ".gitignore" 'BODY CLONEPATH))) - (SETQ GITIGNORE (CL:WITH-OPEN-FILE (STREAM GITIGNORE) + (SETQ GITIGNORE (CL:WITH-OPEN-FILE (STREAM GITIGNORE :EXTERNAL-FORMAT :UTF-8) (bind L until (EOFP STREAM) while (SETQ L (CL:READ-LINE STREAM :EOF-ERROR-P NIL :EOF-VALUE NIL)) @@ -270,9 +269,10 @@ then (UNSLASHIT WP) elseif WORKINGPATH then (ERROR (CONCAT "Can't find the working directory " - (AND (EQ WORKINGPATH T) - "") - " for " PROJECTNAME] + (CL:IF WORKINGPATH + (CONCAT WORKINGPATH " ") + "") + "for " PROJECTNAME] (SETQ PROJECT (create GIT-PROJECT PROJECTNAME _ PROJECTNAME GITHOST _ (PACK* "{" (PSEUDOHOST PROJECTNAME CLONEPATH) @@ -828,10 +828,15 @@ (DEFINEQ (GFILE4MFILE - [LAMBDA (MFILE PROJECT) (* ; "Edited 7-May-2022 23:19 by rmk") + [LAMBDA (MFILE PROJECT) (* ; "Edited 25-Oct-2025 09:18 by rmk") + (* ; "Edited 7-May-2022 23:19 by rmk") (* ; "Edited 4-Feb-2022 18:04 by rmk") - (SLASHIT (PACKFILENAME 'HOST (FETCH GITHOST OF PROJECT) - 'VERSION NIL 'BODY MFILE) + + (* ;; "Switch to UNIX: no versions") + + (SLASHIT (PACKFILENAME 'HOST 'UNIX 'BODY (TRUEFILENAME (PACKFILENAME 'HOST (FETCH GITHOST + OF PROJECT) + 'VERSION NIL 'BODY MFILE))) T]) (MFILE4GFILE @@ -1080,6 +1085,8 @@ (GIT-BRANCH-DIFF [LAMBDA (BRANCH1 BRANCH2 PROJECT) + (* ;; "Edited 21-Oct-2025 18:31 by rmk") + (* ;; "Edited 10-Jun-2024 16:43 by mth") (* ;; "Edited 2-May-2024 11:28 by mth") @@ -1145,7 +1152,7 @@ (GO RETRY)) (ERROR "Incomplete branch differences" (LIST BRANCH1 BRANCH2))) else (for L in ELINES do (PRINTOUT T L T)))) - (RETURN (SORT (for (L FN) in RLINES + (RETURN (SORT (for L FN in RLINES collect (SELCHARQ (CHCON1 L) (A (CL:IF (EQ (CHARCODE TAB) (NTHCHARCODE L 2)) @@ -1156,13 +1163,14 @@ (LIST 'DELETED (SETQ FN (SUBSTRING L 3))) (ERROR "DELETED NOT RECOGNIZED" L))) (M (CL:IF (SETQ POS (STRPOS " " L)) - [LIST 'CHANGED (SETQ FN (SUBSTRING L (ADD1 POS] + [LIST 'MODIFIED (SETQ FN (SUBSTRING L (ADD1 POS] (ERROR "CHANGED NOT RECOGNIZED" L))) - (C (if (AND (EQ (CHARCODE TAB) + (C (* ; + "We coerce a copy to an ADD of the target file") + (if (AND (EQ (CHARCODE TAB) (NTHCHARCODE L 5)) (SETQ POS (STRPOS " " L 7))) - then (LIST 'COPIED (SETQ FN (SUBSTRING L 6 - (SUB1 POS))) + then (LIST 'ADDED (SETQ FN (SUBSTRING L (ADD1 POS))) (OR (FIXP (SUBATOM L 2 4)) (HELP "C without a number" L))) else (HELP "COPY NOT RECOGNIZED" L))) @@ -1431,43 +1439,31 @@ WHENSELECTEDFN _ (FUNCTION GIT-BRANCH-WHENSELECTEDFN)))]) (GIT-BRANCH-WHENSELECTEDFN - [LAMBDA (ITEM MENU BUTTON) (* ; "Edited 21-Mar-2025 19:07 by rmk") + [LAMBDA (ITEM MENU BUTTON) (* ; "Edited 2-Oct-2025 23:08 by rmk") + (* ; "Edited 30-Sep-2025 14:58 by rmk") + (* ; "Edited 21-Mar-2025 19:07 by rmk") (* ; "Edited 11-May-2024 11:05 by rmk") (* ; "Edited 1-May-2024 18:17 by rmk") (* ; "CAR is git key, 4th is project") - (* ;; "This executes the comparison in the current TTY window, either by stuffing the command there or by evaluating there. There probably should be a check to make sure that the TTY is in fact an executive--if not, maybe this should be a no-op. Better than getting the comparison form in the middle of anther SEDIT or TEDIT.") - (* ;; "This could also execute in the mouse process, where the menu is clicked. But in that case a terminal window pops up with the header lines of the compare, and that seems a nuisance.") (LET [(PR (CAR (LAST ITEM] - (if [AND NIL (PROGN (GETMOUSESTATE) - (EQ 'MIDDLE (DECODEBUTTONS] - then (LET [(POS (ADD1 (STRPOS "#" (CAR ITEM] - (ShellBrowse (fetch PRURL of PR))) - elseif (PROGN T) - then - (* ;; "PROGN because DWIM is screwed up") - - (* ;; "The COPYINSERT causes the compare to run in the TTY process, by stuffing the characters in the input line. Somehow it executes even if the parens are not there, but that looks funny. But it also works if I stuff the parens on both sides.") - - (if (EQ BUTTON 'MIDDLE) - then (ShellOpen (CONCAT "https://github.com/Interlisp/medley/pull/" - (fetch (PULLREQUEST PRNUMBER) of PR))) - else (BKSYSBUF '%() - [COPYINSERT `(GIT-PR-COMPARE ,(CADR ITEM) - ',(fetch PRPROJECT of PR] - (BKSYSBUF '%))) + (if (EQ BUTTON 'MIDDLE) + then (ShellOpen (CONCAT "https://github.com/Interlisp/medley/pull/" (fetch (PULLREQUEST + PRNUMBER) + of PR))) else - (* ;; "This puts the print out after the next event number in the TTY window, unfortunately. We go to the default font so we don't get TTYIN's input bold for this.") + (* ;; "This prints notices in its own TTY window") - (PROCESS.EVAL (TTY.PROCESS) - `(RESETLST - [RESETSAVE (DSPFONT DEFAULTFONT T) - '(PROGN (DSPFONT OLDVALUE T])]) + (ADD.PROCESS `[GIT-PR-COMPARE ,(CADR ITEM) + ',(fetch PRPROJECT of PR] + 'NAME + 'prc]) (GIT-PULL-REQUESTS - [LAMBDA (INCLUDEDRAFTS PROJECT) (* ; "Edited 9-May-2025 11:39 by rmk") + [LAMBDA (INCLUDEDRAFTS PROJECT) (* ; "Edited 20-Oct-2025 10:22 by rmk") + (* ; "Edited 9-May-2025 11:39 by rmk") (* ; "Edited 20-May-2024 22:12 by rmk") (* ; "Edited 13-May-2024 18:59 by rmk") (* ; "Edited 11-May-2024 10:51 by rmk") @@ -1495,9 +1491,11 @@ PRDESCRIPTION _ (JSON-GET JSOBJ 'title) PRSTATUS _ (CL:IF DRAFT 'D - (CL:IF (STREQUAL "REVIEW¬REQUIRED" - (JSON-GET JSOBJ 'reviewDecision)) - " " + (SELECTQ (MKATOM (JSON-GET JSOBJ 'reviewDecision)) + (CHANGES¬REQUESTED + 'C) + (REVIEW¬REQUIRED + " ") 'A)) PRPROJECT _ PROJECT PRURL _ (JSON-GET JSOBJ 'url) @@ -1733,6 +1731,8 @@ [LAMBDA (BRANCH1 BRANCH2 DIR1 DIR2 PROJECT) (DECLARE (USEDFREE FROMGITN)) + (* ;; "Edited 21-Oct-2025 18:30 by rmk") + (* ;; "Edited 23-Sep-2025 21:42 by rmk") (* ;; "Edited 22-Sep-2025 12:48 by rmk") @@ -1748,101 +1748,106 @@ (SETQ PROJECT (GIT-GET-PROJECT PROJECT)) (SETQ BRANCH1 (GIT-BRANCH-EXISTS? BRANCH1 NIL PROJECT)) (SETQ BRANCH2 (GIT-BRANCH-EXISTS? BRANCH2 NIL PROJECT)) - (LET (MAPPINGS FROMGIT FROMGITDIR PRNAME (DIFFS (GIT-BRANCH-DIFF BRANCH1 BRANCH2 PROJECT))) - (CL:WHEN DIFFS - (SETQ FROMGIT (PACK* "{FROMGIT" (add FROMGITN 1) - "}")) - - (* ;; "If both origin/, strip it out of subdirectories") - - (SETQ PRNAME (MTOUSTRING (CL:IF (AND (STRPOS "origin/" BRANCH1 NIL T) - (STRPOS "origin/" BRANCH2 NIL T)) - (SUBSTRING BRANCH2 (CONSTANT (NCHARS "origin/ "))) - BRANCH2))) - (PSEUDOHOST FROMGIT (CONCAT "{DSK}" (fetch PROJECTNAME of PROJECT) - "-PR--" PRNAME "--" (DATE) - ">")) - (CL:UNLESS DIR1 - (SETQ DIR1 (CONCAT FROMGIT ""))) - (CL:UNLESS DIR2 - (SETQ DIR2 (CONCAT FROMGIT ""))) - (for D in DIFFS - do - (SELECTQ (CAR D) - (ADDED (* ; + (LET + (MAPPINGS FROMGIT FROMGITDIR PRNAME (DIFFS (GIT-BRANCH-DIFF BRANCH1 BRANCH2 PROJECT))) + (CL:WHEN DIFFS + (SETQ FROMGIT (PACK* "{FROMGIT" (add FROMGITN 1) + "}")) + + (* ;; "If both origin/, strip it out of subdirectories") + + (SETQ PRNAME (CL:IF (AND (STRPOS "origin/" BRANCH1 NIL T) + (STRPOS "origin/" BRANCH2 NIL T)) + (SUBSTRING BRANCH2 (CONSTANT (NCHARS "origin/ "))) + BRANCH2)) + (PSEUDOHOST FROMGIT (CONCAT "{DSK}" (fetch PROJECTNAME of PROJECT) + "-PR--" PRNAME "--" (DATE) + ">")) + (CL:UNLESS DIR1 + (SETQ DIR1 (CONCAT FROMGIT ""))) + (CL:UNLESS DIR2 + (SETQ DIR2 (CONCAT FROMGIT ""))) + (for D in DIFFS + do (SELECTQ (CAR D) + (ADDED (* ;  "Shouldn't exist in BRANCH2, should exist in BRANCH1, but maybe ADDED and DELETED are mixed up?") - (SETQ D (CADR D)) - (OR (GIT-GET-FILE BRANCH1 D (CONCAT DIR1 D) - T PROJECT) - (GIT-GET-FILE BRANCH2 D (CONCAT DIR2 D) - T PROJECT))) - (DELETED - (* ;; "Shouldn't exist in BRANCH1, should exist in BRANCH2. But maybe git is just confused in marking a file that exists in the wrong place as a delete instead of an add, or maybe it may think of a file that doesn't exist at all as having been deleted. Try for both, but don't cause an error.") - - (SETQ D (CADR D)) - (OR (GIT-GET-FILE BRANCH2 D (CONCAT DIR2 D) - T PROJECT) - (GIT-GET-FILE BRANCH1 D (CONCAT DIR1 D) - T PROJECT))) - (CHANGED (* ; "Should exist in both branches") + (SETQ D (CADR D)) + (OR (GIT-GET-FILE BRANCH1 D (CONCAT DIR1 D) + T PROJECT) + (GIT-GET-FILE BRANCH2 D (CONCAT DIR2 D) + T PROJECT))) + (DELETED + (* ;; "Shouldn't exist in BRANCH1, should exist in BRANCH2. But maybe git is just confused in marking a file that exists in the wrong place as a delete instead of an add, or maybe it may think of a file that doesn't exist at all as having been deleted. Try for both, but don't cause an error.") + + (SETQ D (CADR D)) + (OR (GIT-GET-FILE BRANCH2 D (CONCAT DIR2 D) + T PROJECT) + (GIT-GET-FILE BRANCH1 D (CONCAT DIR1 D) + T PROJECT))) + (MODIFIED (* ; "Should exist in both branches") (SETQ D (CADR D)) (GIT-GET-FILE BRANCH1 D (CONCAT DIR1 D) T PROJECT) (GIT-GET-FILE BRANCH2 D (CONCAT DIR2 D) T PROJECT)) - ((RENAMED COPIED) + ((RENAMED COPIED) (* ;; "These entries are from-to filename pairs. If (CADDR) is 100, only need to fetch one, because it presumably has disappeared in BRANCH2 and reappeared in BRANCH1. MAPPINGS is returned so the connection can be reestablished higher up. ") - - (* ;; "If renamed and then changed, for now treat as unrelated adds and deletes: put both files in the fromgit directory. Perhaps the mapping should still figure out how to relate them.") + + (* ;; "If renamed and then changed, for now treat as unrelated adds and deletes: put both files in the fromgit directory. Perhaps the mapping should still figure out how to relate them.") + + (* ;; "For copied files, presumably 2 files are exactly the same. But we hope we can show them on the same line, by virtue of the mapping.") - (* ;; "For copied files, presumably 2 files are exactly the same. But we hope we can show them on the same line, by virtue of the mapping.") + (* ;; + "GIT %"copy%" to a target file is coerced to ADDED of that target; the source is ignore") - [LET ((GFILE (CDR D)) - F1 F2) + (LET ((GFILE (CDR D)) + F1 F2) - (* ;; "GFILE is a triple (F2 F1 N )") + (* ;; "GFILE is a triple (F2 F1 N )") - (* ;; "F1 is the file in branch 1, if any, F2 is in branch 2") + (* ;; "F1 is the file in branch 1, if any, F2 is in branch 2") - (SETQ F1 (GIT-GET-FILE BRANCH1 (CADR GFILE) - (CONCAT DIR1 (CADR GFILE)) - T PROJECT)) - (SETQ F2 (GIT-GET-FILE BRANCH2 (CADR GFILE) - (CONCAT DIR2 (CADR GFILE)) - T PROJECT)) + (SETQ F1 (GIT-GET-FILE BRANCH1 (CADR GFILE) + (CONCAT DIR1 (CADR GFILE)) + T PROJECT)) + (SETQ F2 (GIT-GET-FILE BRANCH2 (CADR GFILE) + (CONCAT DIR2 (CADR GFILE)) + T PROJECT)) - (* ;; "Let the directories figure it out") + (* ;; "Let the directories figure it out") - (AND NIL (if (EQ (CADDR GFILE) - 100) - then + (AND NIL (if (EQ (CADDR GFILE) + 100) + then (* ;; "A little tricky to figure out what corresponds to the real file in the mapping, which directory it belongs to. Maybe the first one should always be one that exists, the second may just be a useful name. But we have to know whether to match against INFO1 or INFO2") - (HELP GFILE 100) - (push MAPPINGS - (LIST (LIST) - (FULLNAME F1) - (SLASHIT (U-CASE (CONCAT DIR2 - (CAR GFILE))) - T) - (NTHCHAR (CAR D) - 1) - 100)) - else - (* ;; + (HELP GFILE 100) + (push MAPPINGS + (LIST (LIST) + (FULLNAME F1) + (SLASHIT (U-CASE (CONCAT DIR2 (CAR GFILE)) + ) + T) + (NTHCHAR (CAR D) + 1) + 100)) + else + (* ;;  "If not a perfect match, then the directory should figure it out") - (GIT-GET-FILE BRANCH2 (CAR GFILE) - (CONCAT DIR2 (CAR GFILE)) - T PROJECT]) - (HELP "UNKNOWN GIT-DIFF TAG" D))) - (LIST DIR1 DIR2 MAPPINGS))]) + (GIT-GET-FILE BRANCH2 (CAR GFILE) + (CONCAT DIR2 (CAR GFILE)) + T PROJECT))) + F2)) + (HELP "UNKNOWN GIT-DIFF TAG" D))) + (LIST DIR1 DIR2 MAPPINGS))]) (GIT-BRANCHES-COMPARE-DIRECTORIES - [LAMBDA (BRANCH1 BRANCH2 LOCAL PROJECT) (* ; "Edited 12-Jun-2024 22:52 by mth") + [LAMBDA (BRANCH1 BRANCH2 LOCAL PROJECT) (* ; "Edited 2-Oct-2025 23:12 by rmk") + (* ; "Edited 12-Jun-2024 22:52 by mth") (* ; "Edited 10-Jun-2024 18:42 by mth") (* ; "Edited 1-May-2024 14:58 by rmk") (* ; "Edited 26-Sep-2023 22:40 by rmk") @@ -1860,8 +1865,10 @@ (SHORT2 (GIT-SHORT-BRANCH-NAME BRANCH2))) (PRINTOUT T "Comparing all " (L-CASE (fetch PROJECTNAME of PROJECT) T) - " subdirectories of " SHORT1 " and " SHORT2 T) - (PRINTOUT T "Fetching differences" T) + " subdirectories of" T) + (PRINTOUT T 5 .FONT BOLDFONT SHORT1 .FONT DEFAULTFONT " and " .FONT BOLDFONT SHORT2 .FONT + DEFAULTFONT T) + (PRINTOUT T "Fetching differences") (SETQ DIRS (GIT-GET-DIFFERENT-FILES BRANCH1 BRANCH2 NIL NIL PROJECT)) (SETQ MAPPINGS (CADDR DIRS)) (if DIRS @@ -1874,10 +1881,10 @@ '(> < ~= -* *-) '(*.* *>*.* .* *>.*) (GIT-GET-PROJECT PROJECT 'EXCLUSIONS) - NIL NIL NIL NIL (LIST (PACKFILENAME 'HOST NIL 'BODY - (CAR DIRS)) - (PACKFILENAME 'HOST NIL 'BODY - (CADR DIRS] + NIL NIL NIL NIL (LIST (FILENAMEFIELD (CAR DIRS) + 'DIRECTORY) + (FILENAMEFIELD (CADR DIRS) + 'DIRECTORY] (* ;; "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 versions.") @@ -1942,100 +1949,103 @@ else '(0 differences)) else '(0 differences]) -(GIT-WORKING-COMPARE-DIRECTORIES +(GIT-WORKING-COMPARE-DIRECTORIES [LAMBDA (SUBDIRS SELECT EXCLUDEDFILES FIXDIRECTORYDATES UPDATE PROJECT) - (* ;; "Edited 29-Apr-2025 15:14 by rmk") + (* ;; "Edited 25-Oct-2025 23:32 by rmk") - (* ;; "Edited 12-Jun-2024 22:52 by mth") + (* ;; "Edited 29-Apr-2025 15:14 by rmk") - (* ;; "Edited 26-Sep-2023 22:41 by rmk") + (* ;; "Edited 12-Jun-2024 22:52 by mth") - (* ;; "Edited 17-Jun-2023 22:54 by rmk") + (* ;; "Edited 26-Sep-2023 22:41 by rmk") - (* ;; "Edited 10-Jun-2023 21:32 by rmk") + (* ;; "Edited 17-Jun-2023 22:54 by rmk") - (* ;; "Edited 20-Jul-2022 21:18 by rmk") + (* ;; "Edited 10-Jun-2023 21:32 by rmk") - (* ;; "Edited 25-Jun-2022 21:37 by rmk") + (* ;; "Edited 20-Jul-2022 21:18 by rmk") - (* ;; "Edited 17-May-2022 17:39 by rmk") + (* ;; "Edited 25-Jun-2022 21:37 by rmk") - (* ;; "Edited 10-May-2022 10:41 by rmk") + (* ;; "Edited 17-May-2022 17:39 by rmk") + + (* ;; "Edited 10-May-2022 10:41 by rmk") (* ;; - "Edited 29-Mar-2022 13:58 by rmk: working medley subdirectories with the current local git branch.") + "Edited 29-Mar-2022 13:58 by rmk: working medley subdirectories with the current local git branch.") - (SETQ PROJECT (GIT-GET-PROJECT PROJECT)) - (CL:WHEN UPDATE (GIT-REMOTE-UPDATE NIL PROJECT)) (* ; "Doesn't matter if we are looking only at local files in the current branch. We aren't fetching or checking out.") - (CL:UNLESS (AND (fetch GITHOST of PROJECT) - (fetch WHOST of PROJECT)) - (ERROR (fetch PROJECTNAME of PROJECT) + (SETQ PROJECT (GIT-GET-PROJECT PROJECT)) + (CL:WHEN UPDATE (GIT-REMOTE-UPDATE NIL PROJECT)) (* ; "Doesn't matter if we are looking only at local files in the current branch. We aren't fetching or checking out.") + (CL:UNLESS (AND (fetch GITHOST of PROJECT) + (fetch WHOST of PROJECT)) + (ERROR (fetch PROJECTNAME of PROJECT) " does not have both git and working directories")) - (CL:WHEN (AND (LISTP SUBDIRS) - (NULL (CDR SUBDIRS))) - (SETQ SUBDIRS (CAR SUBDIRS))) + (CL:WHEN (AND (LISTP SUBDIRS) + (NULL (CDR SUBDIRS))) + (SETQ SUBDIRS (CAR SUBDIRS))) (CL:UNLESS SUBDIRS - (SETQ SUBDIRS (OR (fetch DEFAULTSUBDIRS of PROJECT) + (SETQ SUBDIRS (OR (fetch DEFAULTSUBDIRS of PROJECT) 'ALL))) - (SETQ SUBDIRS (L-CASE SUBDIRS)) - (LET ((SUBDIRSTRING (if (EQ SUBDIRS 'all) - then (SETQ SUBDIRS (ALLSUBDIRS PROJECT)) + (SETQ SUBDIRS (L-CASE SUBDIRS)) + (LET ((SUBDIRSTRING (if (EQ SUBDIRS 'all) + then (SETQ SUBDIRS (ALLSUBDIRS PROJECT)) "ALL subdirectories" - else SUBDIRS))) - (for SUBDIR TITLE CDVAL (WPROJ _ (CONCAT "Working " (L-CASE (fetch PROJECTNAME of PROJECT) + else SUBDIRS))) + (for SUBDIR TITLE CDVAL (WPROJ _ (CONCAT "Working " (L-CASE (fetch PROJECTNAME of PROJECT) T))) (NENTRIES _ 0) - (BRANCH2 _ (GIT-WHICH-BRANCH PROJECT T)) - first (PRINTOUT T "Comparing " SUBDIRSTRING 6 " of " WPROJ " and Git " BRANCH2 T) - (BKSYSBUF " ") inside SUBDIRS - collect (TERPRI T) - (SETQ CDVAL (COMPAREDIRECTORIES (MYMEDLEYSUBDIR SUBDIR T PROJECT) - (GITSUBDIR SUBDIR T PROJECT) - (OR SELECT '(> < ~= -* *-)) + (BRANCH2 _ (GIT-WHICH-BRANCH PROJECT T)) + first (PRINTOUT T "Comparing " SUBDIRSTRING 6 " of " WPROJ " and Git " BRANCH2 T) + (BKSYSBUF " ") inside SUBDIRS + collect (TERPRI T) + (SETQ CDVAL (COMPAREDIRECTORIES (MYMEDLEYSUBDIR SUBDIR T PROJECT) + (GITSUBDIR SUBDIR T PROJECT) + (OR SELECT '(> < ~= -* *-)) '(*.* *>*.* .* *>.*) - (for E DPOS in (GIT-GET-PROJECT PROJECT 'EXCLUSIONS) - collect (SETQ DPOS (STRPOS SUBDIR (FILENAMEFIELD E + (for E DPOS in (GIT-GET-PROJECT PROJECT 'EXCLUSIONS) + collect (SETQ DPOS (STRPOS SUBDIR (FILENAMEFIELD E 'DIRECTORY) 1 NIL T T FILEDIRCASEARRAY)) (CL:IF DPOS - (SUBSTRING E (ADD1 DPOS)) + (SUBSTRING E (ADD1 DPOS)) E)) 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)))] + [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 + 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.") + (* ;; "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) + (CL:WHEN (AND (CDR $$VAL) GIT-MERGE-COMPARES) - (SETQ $$VAL (CDMERGE $$VAL)) - [SETQ SUBDIRS (CONCATLIST (for SUBDIR in SUBDIRS collect (CONCAT SUBDIR " "]) - [for CDVAL TITLE in $$VAL as SUBDIR inside SUBDIRS - do (SETQ TITLE (CONCAT WPROJ " vs. " BRANCH2 " " SUBDIR " " - (LENGTH (fetch (CDVALUE CDENTRIES) of CDVAL)) + (SETQ $$VAL (CDMERGE $$VAL)) + [SETQ SUBDIRS (CONCATLIST (for SUBDIR in SUBDIRS collect (CONCAT SUBDIR " "]) + [for CDVAL TITLE in $$VAL as SUBDIR inside SUBDIRS + do (SETQ TITLE (CONCAT WPROJ " vs. " BRANCH2 " " SUBDIR " " + (LENGTH (fetch (CDVALUE CDENTRIES) of CDVAL)) " files")) - [CDBROWSER CDVAL TITLE `(,WPROJ ,BRANCH2) + [CDBROWSER CDVAL TITLE `(,WPROJ ,BRANCH2) `(BRANCH1 ,WPROJ BRANCH2 ,BRANCH2 SUBDIR ,SUBDIR LABELFN GIT-CD-LABELFN PROJECT ,PROJECT) GIT-CDBROWSER-SEPARATE-DIRECTIONS `(Compare See "" Copy% <- (|Delete ALL <-| GIT-CD-MENUFN) - ,@(CL:UNLESS (GIT-MAINBRANCH? BRANCH2 PROJECT T) - '("" 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-WMEDLEY-CDVALUES $$VAL) - (TERPRI T) - (RETURN (LIST NENTRIES (CL:IF (EQ NENTRIES 1) + ,@(CL:UNLESS (GIT-MAINBRANCH? BRANCH2 PROJECT T) + '("" (Copy% -> GIT-CD-MENUFN NIL T) + (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-WMEDLEY-CDVALUES $$VAL) + (TERPRI T) + (RETURN (LIST NENTRIES (CL:IF (EQ NENTRIES 1) 'difference 'differences)]) @@ -2203,7 +2213,8 @@ (OR LABEL2 FILE2]) (GIT-CD-MENUFN - [LAMBDA (TBITEM MENUITEM CDBROWSER KEY) (* ; "Edited 21-Sep-2022 21:34 by rmk") + [LAMBDA (TBITEM MENUITEM CDBROWSER KEY) (* ; "Edited 25-Oct-2025 23:44 by rmk") + (* ; "Edited 21-Sep-2022 21:34 by rmk") (* ; "Edited 22-May-2022 19:13 by rmk") (* ; "Edited 8-May-2022 09:26 by rmk") (* ; "Edited 10-Dec-2021 08:52 by rmk") @@ -2239,6 +2250,7 @@ (GIT-DELETE-FILE FILE2 (LISTGET USERDATA 'PROJECT)) (MYMEDLEY-DELETE-FILES FILE1 (LISTGET USERDATA 'PROJECT)) (TB.DELETE.ITEM CDBROWSER TBITEM))) + (Copy% -> (CDBROWSER-COPY CDBROWSER TBITEM 'LEFT (CADDDR MENUITEM))) (SHOULDNT]) (GIT-WORKING-COMPARE-FILES @@ -2439,33 +2451,33 @@ (PUTPROPS GITFNS FILETYPE :TCOMPL) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4193 20772 (GIT-CLONEP 4203 . 5531) (GIT-INIT 5533 . 6163) (GIT-MAKE-PROJECT 6165 . -13830) (GIT-GET-PROJECT 13832 . 15757) (GIT-PUT-PROJECT-FIELD 15759 . 17400) (GIT-PROJECT-PATH 17402 - . 18446) (FIND-ANCESTOR-DIRECTORY 18448 . 18797) (GIT-FIND-CLONE 18799 . 19880) (GIT-MAINBRANCH 19882 - . 20277) (GIT-MAINBRANCH? 20279 . 20770)) (26235 31164 (PRC-COMMAND 26245 . 31162)) (31220 34008 ( -ALLSUBDIRS 31230 . 32516) (MEDLEYSUBDIRS 32518 . 33211) (GITSUBDIRS 33213 . 34006)) (34009 38799 ( -TOGIT 34019 . 35425) (FROMGIT 35427 . 36408) (GIT-DELETE-FILE 36410 . 37256) (MYMEDLEY-DELETE-FILES -37258 . 38797)) (38800 41803 (MYMEDLEYSUBDIR 38810 . 39266) (GITSUBDIR 39268 . 39711) (STRIPDIR 39713 - . 40084) (STRIPHOST 40086 . 40326) (STRIPNAME 40328 . 41081) (STRIPWHERE 41083 . 41801)) (41804 43706 - (GFILE4MFILE 41814 . 42177) (MFILE4GFILE 42179 . 42748) (GIT-REPO-FILENAME 42750 . 43704)) (43755 -54010 (GIT-COMMIT 43765 . 44591) (GIT-PUSH 44593 . 45353) (GIT-PULL 45355 . 46107) (GIT-APPROVAL 46109 - . 46458) (GIT-GET-FILE 46460 . 48375) (GIT-FILE-EXISTS? 48377 . 48651) (GIT-REMOTE-UPDATE 48653 . -49488) (GIT-REMOTE-ADD 49490 . 49797) (GIT-FILE-DATE 49799 . 50846) (GIT-FILE-HISTORY 50848 . 52782) ( -GIT-PRINT-FILE-HISTORY 52784 . 53834) (GIT-FETCH 53836 . 54008)) (54040 65378 (GIT-BRANCH-DIFF 54050 - . 60797) (GIT-COMMIT-DIFFS 60799 . 61690) (GIT-BRANCH-RELATIONS 61692 . 65376)) (65423 84918 ( -GIT-BRANCH-NUM 65433 . 66006) (GIT-CHECKOUT 66008 . 67294) (GIT-WHICH-BRANCH 67296 . 67703) ( -GIT-MAKE-BRANCH 67705 . 70284) (GIT-BRANCHES 70286 . 72881) (GIT-BRANCH-EXISTS? 72883 . 73754) ( -GIT-PICK-BRANCH 73756 . 74246) (GIT-BRANCH-MENU 74248 . 75129) (GIT-BRANCH-WHENSELECTEDFN 75131 . -77670) (GIT-PULL-REQUESTS 77672 . 81299) (GIT-SHORT-BRANCH-NAME 81301 . 81592) (GIT-LONG-NAME 81594 . -81911) (GIT-PRC-BRANCHES 81913 . 84916)) (84948 88396 (GIT-MY-CURRENT-BRANCH 84958 . 85328) ( -GIT-MY-BRANCHP 85330 . 85948) (GIT-MY-NEXT-BRANCH 85950 . 86444) (GIT-MY-BRANCHES 86446 . 88394)) ( -88442 92517 (GIT-ADD-WORKTREE 88452 . 90059) (GIT-REMOVE-WORKTREE 90061 . 90991) (GIT-LIST-WORKTREES -90993 . 91797) (WORKTREEDIR 91799 . 92515)) (92565 126387 (GIT-GET-DIFFERENT-FILES 92575 . 99428) ( -GIT-BRANCHES-COMPARE-DIRECTORIES 99430 . 106661) (GIT-WORKING-COMPARE-DIRECTORIES 106663 . 112370) ( -GIT-COMPARE-WORKTREE 112372 . 116350) (GITCDOBJBUTTONFN 116352 . 120842) (GIT-CD-LABELFN 120844 . -121926) (GIT-CD-MENUFN 121928 . 124368) (GIT-WORKING-COMPARE-FILES 124370 . 124990) ( -GIT-BRANCHES-COMPARE-FILES 124992 . 126156) (GIT-PR-COMPARE 126158 . 126385)) (126457 134780 (CDGITDIR - 126467 . 127154) (GIT-COMMAND 127156 . 128714) (GITORIGIN 128716 . 129413) (GIT-INITIALS 129415 . -129719) (GIT-COMMAND-TO-FILE 129721 . 133206) (GIT-RESULT-TO-LINES 133208 . 134113) (STRIPLOCAL 134115 - . 134778))))) + (FILEMAP (NIL (4243 21049 (GIT-CLONEP 4253 . 5684) (GIT-INIT 5686 . 6316) (GIT-MAKE-PROJECT 6318 . +14107) (GIT-GET-PROJECT 14109 . 16034) (GIT-PUT-PROJECT-FIELD 16036 . 17677) (GIT-PROJECT-PATH 17679 + . 18723) (FIND-ANCESTOR-DIRECTORY 18725 . 19074) (GIT-FIND-CLONE 19076 . 20157) (GIT-MAINBRANCH 20159 + . 20554) (GIT-MAINBRANCH? 20556 . 21047)) (26512 31441 (PRC-COMMAND 26522 . 31439)) (31497 34285 ( +ALLSUBDIRS 31507 . 32793) (MEDLEYSUBDIRS 32795 . 33488) (GITSUBDIRS 33490 . 34283)) (34286 39076 ( +TOGIT 34296 . 35702) (FROMGIT 35704 . 36685) (GIT-DELETE-FILE 36687 . 37533) (MYMEDLEY-DELETE-FILES +37535 . 39074)) (39077 42080 (MYMEDLEYSUBDIR 39087 . 39543) (GITSUBDIR 39545 . 39988) (STRIPDIR 39990 + . 40361) (STRIPHOST 40363 . 40603) (STRIPNAME 40605 . 41358) (STRIPWHERE 41360 . 42078)) (42081 44316 + (GFILE4MFILE 42091 . 42787) (MFILE4GFILE 42789 . 43358) (GIT-REPO-FILENAME 43360 . 44314)) (44365 +54620 (GIT-COMMIT 44375 . 45201) (GIT-PUSH 45203 . 45963) (GIT-PULL 45965 . 46717) (GIT-APPROVAL 46719 + . 47068) (GIT-GET-FILE 47070 . 48985) (GIT-FILE-EXISTS? 48987 . 49261) (GIT-REMOTE-UPDATE 49263 . +50098) (GIT-REMOTE-ADD 50100 . 50407) (GIT-FILE-DATE 50409 . 51456) (GIT-FILE-HISTORY 51458 . 53392) ( +GIT-PRINT-FILE-HISTORY 53394 . 54444) (GIT-FETCH 54446 . 54618)) (54650 66130 (GIT-BRANCH-DIFF 54660 + . 61549) (GIT-COMMIT-DIFFS 61551 . 62442) (GIT-BRANCH-RELATIONS 62444 . 66128)) (66175 84914 ( +GIT-BRANCH-NUM 66185 . 66758) (GIT-CHECKOUT 66760 . 68046) (GIT-WHICH-BRANCH 68048 . 68455) ( +GIT-MAKE-BRANCH 68457 . 71036) (GIT-BRANCHES 71038 . 73633) (GIT-BRANCH-EXISTS? 73635 . 74506) ( +GIT-PICK-BRANCH 74508 . 74998) (GIT-BRANCH-MENU 75000 . 75881) (GIT-BRANCH-WHENSELECTEDFN 75883 . +77422) (GIT-PULL-REQUESTS 77424 . 81295) (GIT-SHORT-BRANCH-NAME 81297 . 81588) (GIT-LONG-NAME 81590 . +81907) (GIT-PRC-BRANCHES 81909 . 84912)) (84944 88392 (GIT-MY-CURRENT-BRANCH 84954 . 85324) ( +GIT-MY-BRANCHP 85326 . 85944) (GIT-MY-NEXT-BRANCH 85946 . 86440) (GIT-MY-BRANCHES 86442 . 88390)) ( +88438 92513 (GIT-ADD-WORKTREE 88448 . 90055) (GIT-REMOVE-WORKTREE 90057 . 90987) (GIT-LIST-WORKTREES +90989 . 91793) (WORKTREEDIR 91795 . 92511)) (92561 126762 (GIT-GET-DIFFERENT-FILES 92571 . 99479) ( +GIT-BRANCHES-COMPARE-DIRECTORIES 99481 . 106920) (GIT-WORKING-COMPARE-DIRECTORIES 106922 . 112559) ( +GIT-COMPARE-WORKTREE 112561 . 116539) (GITCDOBJBUTTONFN 116541 . 121031) (GIT-CD-LABELFN 121033 . +122115) (GIT-CD-MENUFN 122117 . 124743) (GIT-WORKING-COMPARE-FILES 124745 . 125365) ( +GIT-BRANCHES-COMPARE-FILES 125367 . 126531) (GIT-PR-COMPARE 126533 . 126760)) (126832 135155 (CDGITDIR + 126842 . 127529) (GIT-COMMAND 127531 . 129089) (GITORIGIN 129091 . 129788) (GIT-INITIALS 129790 . +130094) (GIT-COMMAND-TO-FILE 130096 . 133581) (GIT-RESULT-TO-LINES 133583 . 134488) (STRIPLOCAL 134490 + . 135153))))) STOP diff --git a/lispusers/GITFNS.LCOM b/lispusers/GITFNS.LCOM index c37122464..bab7dfcc9 100644 Binary files a/lispusers/GITFNS.LCOM and b/lispusers/GITFNS.LCOM differ