diff --git a/library/CLIPBOARD.TXT b/library/CLIPBOARD.TXT index d8370382..b8959830 100644 --- a/library/CLIPBOARD.TXT +++ b/library/CLIPBOARD.TXT @@ -4,13 +4,13 @@ Written by Ron Kaplan, 2020-2021 A small package that implements copy and paste to the system clipboard. -For Tedit, Sedit, and perhaps other applications, meta-C is armed for copy to the clipboard from the current selection, and also meta-X is armed for extraction (copy followed by delete). +It arms meta-C for copy to the clipboard from the current selection of an application that has been armed (Tedit, Sedit), and also meta-X for extraction (copy followed by delete). -Meta-V is defined as an interrupt character that pastes the current clipboard contents into whatever process currently has input focus. +Meta-V is defined as an interrupt character that pastes the current clipboard contents into whatever process curent has input focus. -The information in the clipboard can be provided from or provided to external (non-Medley) applications (mail, emacs, etc.) in the usual way. For example, a form selected in SEDIT can be copied to the clipboard and pasted into an email message. +The information in the clipboard can be provided from or provided to external (non-Medley) applications (mail, emacs, etc.) in the usual way. For example, a form cselected in SEDIT can be copied to the clipboard and pasted into an email message. -It assumes that the clipboard is a UTF-8/Unicode stream, and uses the UNICODE package to convert to and from the Medley internal character encoding (XCCS). +It assumes that the external format of the clipboard is determined by (SYSTEM-EXTERNALFORMAT, and characters will be converted to and from the Medley internal character encoding. The name of the clipboard stream may differ from platform to platform. On the Mac, the paste stream is "pbpaste" and the copy stream is "pbcopy". Those names are used if "darwin" is a substring of (UNIX-GETENV "ostype"). Otherwise both stream-names default to "xclip". The functions CLIPBOARD-COPY-STREAM and CLIPBOARD-PASTE-STREAM perform this selection. diff --git a/lispusers/COMPAREDIRECTORIES b/lispusers/COMPAREDIRECTORIES index 98930a1e..c1c5a167 100644 --- a/lispusers/COMPAREDIRECTORIES +++ b/lispusers/COMPAREDIRECTORIES @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "25-May-2022 08:44:46"  -{DSK}kaplan>Local>medley3.5>working-medley>lispusers>COMPAREDIRECTORIES.;234 125334 +(FILECREATED "17-Jul-2022 11:04:12"  +{DSK}kaplan>Local>medley3.5>working-medley>lispusers>COMPAREDIRECTORIES.;245 127291 :CHANGES-TO (VARS COMPAREDIRECTORIESCOMS) - :PREVIOUS-DATE "24-May-2022 15:49:54" -{DSK}kaplan>Local>medley3.5>working-medley>lispusers>COMPAREDIRECTORIES.;233) + :PREVIOUS-DATE "16-Jul-2022 10:41:54" +{DSK}kaplan>Local>medley3.5>working-medley>lispusers>COMPAREDIRECTORIES.;244) (* ; " @@ -27,7 +27,7 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp CDTEDIT) (FNS CDMAP CDENTRY CDSUBSET CDMERGE CDMERGE.COMMON) (FNS BINCOMP EOLTYPE EOLTYPE.SHOW) - (RECORDS CDVALUE CDENTRY CDINFO CDMAXNCHARS) + (RECORDS CDMAXNCHARS CDVALUE CDENTRY CDINFO) (* ;; "look for compiled files older than the sources") @@ -554,7 +554,8 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp (DEFINEQ (CDPRINT - [LAMBDA (CDVALUE FILE COLHEADINGS PRINTAUTHOR) (* ; "Edited 26-Jan-2022 13:43 by rmk") + [LAMBDA (CDVALUE FILE COLHEADINGS PRINTAUTHOR) (* ; "Edited 15-Jul-2022 12:03 by rmk") + (* ; "Edited 26-Jan-2022 13:43 by rmk") (* ; "Edited 19-Dec-2021 20:10 by rmk") (* ; "Edited 30-Nov-2021 20:59 by rmk:") (* ; "Edited 13-Oct-2020 08:38 by rmk:") @@ -569,6 +570,7 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp (COL1WIDTH (POP COLUMNS)) (COL2WIDTH (POP COLUMNS)) (COL2START (POP COLUMNS)) + (LENGTH2END (POP COLUMNS)) (NCHARSDIR1 (FETCH NCDIR OF (FETCH CDMAXNC1 OF CDVALUE))) (NCHARSDIR2 (FETCH NCDIR OF (FETCH CDMAXNC2 OF CDVALUE] (CL:UNLESS (SETQ STREAM (GETSTREAM FILE 'OUTPUT T)) @@ -585,7 +587,7 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp then (CDPRINT.COLHEADERS STREAM COLHEADINGS ENDDATE1 COL1WIDTH COL2START COL2WIDTH) (for E in (fetch CDENTRIES of CDVALUE) do (CDPRINT.LINE STREAM E PRINTAUTHOR DATE1POS ENDDATE1 NCHARSDIR1 - NCHARSDIR2)) + NCHARSDIR2 LENGTH2END)) else (PRINTOUT T "CDVALUE is empty" T)) (AND STREAM (CLOSEF? STREAM))))]) @@ -611,7 +613,8 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp (CL:WHEN SELECT (PRINTOUT STREAM " selecting " SELECT)))]) (CDPRINT.LINE - [LAMBDA (STREAM ENTRY PRINTAUTHOR DATE1POS ENDDATE1 NCHARSDIR1 NCHARSDIR2) + [LAMBDA (STREAM ENTRY PRINTAUTHOR DATE1POS ENDDATE1 NCHARSDIR1 NCHARSDIR2 LENGTH2END) + (* ; "Edited 16-Jul-2022 10:19 by rmk") (* ; "Edited 22-Nov-2021 22:38 by rmk:") (* ; "Edited 9-Jan-2021 10:12 by rmk:") @@ -642,13 +645,21 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp (CL:WHEN PRINTAUTHOR (PRINTOUT STREAM "(" (fetch (CDINFO AUTHOR) OF INFO1) ") ")) - (PRINTOUT STREAM (fetch (CDINFO LENGTH) OF INFO1) - .TAB0 DATE1POS (fetch DATE of INFO1))) - (PRINTOUT STREAM .TAB0 ENDDATE1 " " (fetch DATEREL of ENTRY) + (PRINTOUT STREAM .FR (IDIFFERENCE DATE1POS 2) + (fetch (CDINFO LENGTH) OF INFO1) + " " + (fetch DATE of INFO1))) + (PRINTOUT STREAM .TAB0 ENDDATE1 " " (SELECTQ (fetch DATEREL of ENTRY) + (< "< ") + (> " >") + (* (CL:IF INFO1 + " *" + "* ")) + (SHOULDNT)) " ") (CL:WHEN INFO2 (PRINTOUT STREAM (fetch DATE of INFO2) - " " + " " (SUBSTRING (fetch (CDINFO FULLNAME) OF INFO2) (ADD1 NCHARSDIR2) NIL @@ -657,7 +668,8 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp (CL:WHEN PRINTAUTHOR (PRINTOUT STREAM "(" (fetch (CDINFO AUTHOR) OF INFO2) ") ")) - (PRINTOUT STREAM (fetch (CDINFO LENGTH) OF INFO2))) + (PRINTOUT STREAM .FR LENGTH2END (fetch (CDINFO LENGTH) OF INFO2)) + (PRINTOUT STREAM " ")) (* ; "A little margin in the window") (TERPRI STREAM]) (CDPRINT.MAXWIDTHS @@ -717,23 +729,32 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp (CDPRINT.COLHEADERS [LAMBDA (STREAM COLHEADINGS ENDDATE1 COL1WIDTH COL2START COL2WIDTH) + (* ; "Edited 16-Jul-2022 10:38 by rmk") (* ; "Edited 30-Nov-2021 14:47 by rmk:") (* ;; "If column headers are provided, center them over the columns") - (CL:WHEN (EQLENGTH COLHEADINGS 2) - (TAB (DIFFERENCE ENDDATE1 COL1WIDTH) - 0 STREAM) - (FLUSHRIGHT ENDDATE1 (CAR COLHEADINGS) - 0 NIL T STREAM) - (TAB COL2START 0 STREAM) - (FLUSHRIGHT (PLUS COL2START COL2WIDTH) - (CADR COLHEADINGS) - 0 NIL T STREAM) - (TERPRI STREAM))]) + (CL:WHEN (LISTP COLHEADINGS) + (LET (HEADING) + (CL:WHEN (SETQ HEADING (CAR COLHEADINGS)) + (CL:WHEN (IGREATERP (NCHARS HEADING) + COL1WIDTH) (* ; "Truncate to column width") + (SETQ HEADING (SUBSTRING HEADING 1 COL1WIDTH))) + (TAB (DIFFERENCE ENDDATE1 COL1WIDTH) + 0 STREAM) + (FLUSHRIGHT ENDDATE1 HEADING 0 NIL T STREAM)) + (CL:WHEN [SETQ HEADING (CAR (LISTP (CDR COLHEADINGS] + (CL:WHEN (IGREATERP (NCHARS HEADING) + COL2WIDTH) + (SETQ HEADING (SUBSTRING HEADING 1 COL2WIDTH))) + (TAB COL2START 0 STREAM) + (FLUSHRIGHT (PLUS COL2START COL2WIDTH) + HEADING 0 NIL T STREAM)) + (TERPRI STREAM)))]) (CDPRINT.COLUMNS - [LAMBDA (CDVALUE COLHEADINGS PRINTAUTHOR) (* ; "Edited 30-Nov-2021 14:03 by rmk:") + [LAMBDA (CDVALUE COLHEADINGS PRINTAUTHOR) (* ; "Edited 16-Jul-2022 10:40 by rmk") + (* ; "Edited 30-Nov-2021 14:03 by rmk:") (* ;; "Compute the column locations for CDPRINT.LINE") @@ -742,13 +763,14 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp (SETQ CDVALUE (CD.INSURECDVALUE CDVALUE)) (LET (INFO1 DATE1POS ENDDATE1 (COL1WIDTH 10) (COL2WIDTH 10) - (DATERELWIDTH 5) + (DATERELWIDTH 6) (MAXWIDTHS1 (FETCH (CDVALUE CDMAXNC1) OF CDVALUE)) (MAXWIDTHS2 (FETCH (CDVALUE CDMAXNC2) OF CDVALUE)) (MAXAUTHOR1 0) (MAXAUTHOR2 0) [DATEWIDTH (CONSTANT (NCHARS (DATE] - MAXFILE1WIDTH MAXFILE2WIDTH (EQUIV 4)) + MAXNAME1 MAXNAME2 (EQUIV 4) + COL2START LENGTH2END) (* ;; "DATE1POS is the position of the first character of INFO1's date, used for tabbing. We have to measure the filename, date, size, and author if desired") @@ -758,37 +780,38 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp (* ;; "Even though the longest length and author might not go with the longest file name, it is a reasonable approximation to assume that in fact the longest filename did have the longest length. Lengths differ by just a few characters, and a long length with a short filename might balance out. If the long file did have a long length, then it would all be exact. ") - (* ;; "Include space between truncated file and length") - - [SETQ MAXFILE1WIDTH (IMAX 10 (IPLUS (IDIFFERENCE (fetch NCFULLNAME of MAXWIDTHS1) - (FETCH NCDIR OF MAXWIDTHS1)) - (CONSTANT (NCHARS " ")) - (fetch NCLENGTH of MAXWIDTHS1] - [SETQ MAXFILE2WIDTH (IMAX 10 (NCHARS (CADR COLHEADINGS)) - (IPLUS (IDIFFERENCE (fetch NCFULLNAME of MAXWIDTHS2) - (FETCH NCDIR OF MAXWIDTHS2)) - (CONSTANT (NCHARS " ")) - (fetch NCLENGTH of MAXWIDTHS2] + (SETQ MAXNAME1 (IDIFFERENCE (fetch NCFULLNAME of MAXWIDTHS1) + (fetch NCDIR OF MAXWIDTHS1))) + (SETQ MAXNAME2 (IDIFFERENCE (fetch NCFULLNAME of MAXWIDTHS2) + (fetch NCDIR OF MAXWIDTHS2))) (CL:WHEN PRINTAUTHOR - (SETQ MAXAUTHOR1 (IPLUS (CONSTANT (NCHARS "() ")) - (fetch NCAUTHOR of MAXWIDTHS1))) - (SETQ MAXAUTHOR2 (IPLUS (CONSTANT (NCHARS "() ")) - (fetch NCAUTHOR of MAXWIDTHS2)))) - (* ;; - "First 4 for width of equiv. 2 spaces between end of widest file and the date column") + (* ;; "MAXAUTHOR includes its own suffixspace") - [SETQ DATE1POS (IPLUS EQUIV MAXFILE1WIDTH MAXAUTHOR1 (CONSTANT (NCHARS " "] - (SETQ ENDDATE1 (IPLUS DATE1POS DATEWIDTH)) + [SETQ MAXAUTHOR1 (IPLUS (CONSTANT (NCHARS "(")) + (fetch NCAUTHOR of MAXWIDTHS1) + (CONSTANT (NCHARS ") "] + [SETQ MAXAUTHOR2 (IPLUS (CONSTANT (NCHARS (NCHARS "("))) + (fetch NCAUTHOR of MAXWIDTHS2) + (CONSTANT (NCHARS ") "]) + (SETQ COL1WIDTH (IPLUS MAXNAME1 1 MAXAUTHOR1 (fetch NCLENGTH of MAXWIDTHS1) + 2 DATEWIDTH)) + (SETQ DATE1POS (IPLUS EQUIV (IDIFFERENCE COL1WIDTH DATEWIDTH))) + (SETQ ENDDATE1 (IPLUS EQUIV COL1WIDTH)) + (SETQ COL2WIDTH (IPLUS DATEWIDTH 2 MAXNAME2 1 MAXAUTHOR2 (fetch NCLENGTH + of MAXWIDTHS2))) - (* ;; "If column headers are provided, center them over the columns") - - (CL:WHEN (EQLENGTH COLHEADINGS 2) - (SETQ COL1WIDTH (IMAX (NCHARS (CAR COLHEADINGS)) - (IPLUS MAXFILE1WIDTH MAXAUTHOR1 DATEWIDTH))) - (SETQ COL2WIDTH (IMAX (NCHARS (CADR COLHEADINGS)) - (IPLUS MAXFILE2WIDTH MAXAUTHOR2 DATEWIDTH)))) - (LIST DATE1POS ENDDATE1 COL1WIDTH COL2WIDTH (PLUS EQUIV COL1WIDTH DATERELWIDTH]) + (* ;; "If column headers are provided, center them over the columns. But don't expand the column, the headers will be truncated.") + (* (CL:WHEN (CAR (LISTP COLHEADINGS)) + (SETQ COL1WIDTH (IMAX 10 + (NCHARS (CAR COLHEADINGS)) COL1WIDTH)))) + (SETQ COL2START (PLUS EQUIV COL1WIDTH DATERELWIDTH)) + (* (CL:WHEN (CAR (LISTP + (CDR COLHEADINGS))) (SETQ COL2WIDTH + (IMAX 10 (NCHARS (CADR COLHEADINGS)) + COL2WIDTH)))) + (SETQ LENGTH2END (IPLUS COL2START COL2WIDTH)) + (LIST DATE1POS ENDDATE1 COL1WIDTH COL2WIDTH COL2START LENGTH2END]) (CDTEDIT [LAMBDA (CDVALUE TITLE COLHEADINGS PRINTAUTHOR) (* ; "Edited 5-Nov-2021 16:44 by rmk:") @@ -1068,6 +1091,8 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp ) (DECLARE%: EVAL@COMPILE +(RECORD CDMAXNCHARS (NCFULLNAME NCLENGTH NCAUTHOR NCTYPE NCDIR)) + (RECORD CDVALUE ((CDDIR1 CDDIR2 CDCOMPAREDATE CDSELECT CDMAXNC1 CDMAXNC2) . CDENTRIES) (RECORD CDVALUE (CDPARAMETERS)) CDMAXNC1 _ (CREATE CDMAXNCHARS) @@ -1076,8 +1101,6 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp (RECORD CDENTRY (MATCHNAME INFO1 DATEREL INFO2 . EQUIV)) (RECORD CDINFO (FULLNAME DATE LENGTH AUTHOR TYPE EOL)) - -(RECORD CDMAXNCHARS (NCFULLNAME NCLENGTH NCAUTHOR NCTYPE NCDIR)) ) @@ -2122,21 +2145,21 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp COMPAREDIRECTORIES.CANDIDATES 10361 . 13746) (CDENTRIES.SELECT 13748 . 18523) ( COMPAREDIRECTORIES.INFOS.TYPE 18525 . 19431) (MATCHNAME 19433 . 20113) (CD.INSURECDVALUE 20115 . 21729 ) (CD.UPDATEWIDTHS 21731 . 22195)) (22198 31867 (CDFILES 22208 . 27961) (CDFILES.MATCH 27963 . 29588) -(CDFILES.PATS 29590 . 31865)) (31868 46953 (CDPRINT 31878 . 34223) (CDPRINT.HEADER 34225 . 35122) ( -CDPRINT.LINE 35124 . 37680) (CDPRINT.MAXWIDTHS 37682 . 41797) (CDPRINT.COLHEADERS 41799 . 42437) ( -CDPRINT.COLUMNS 42439 . 46318) (CDTEDIT 46320 . 46951)) (46954 55323 (CDMAP 46964 . 48396) (CDENTRY -48398 . 48707) (CDSUBSET 48709 . 50148) (CDMERGE 50150 . 54004) (CDMERGE.COMMON 54006 . 55321)) (55324 - 62862 (BINCOMP 55334 . 59623) (EOLTYPE 59625 . 62187) (EOLTYPE.SHOW 62189 . 62860)) (63390 75917 ( -FIND-UNCOMPILED-FILES 63400 . 67043) (FIND-UNSOURCED-FILES 67045 . 69429) (FIND-SOURCE-FILES 69431 . -71169) (FIND-COMPILED-FILES 71171 . 73048) (FIND-UNLOADED-FILES 73050 . 73903) (FIND-LOADED-FILES -73905 . 74333) (FIND-MULTICOMPILED-FILES 74335 . 75915)) (75918 84349 (CREATED-AS 75928 . 80725) ( -SOURCE-FOR-COMPILED-P 80727 . 83654) (COMPILE-SOURCE-DATE-DIFF 83656 . 84347)) (84350 94656 ( -FIX-DIRECTORY-DATES 84360 . 87353) (FIX-EQUIV-DATES 87355 . 88880) (COPY-COMPARED-FILES 88882 . 90703) - (COPY-MISSING-FILES 90705 . 92862) (COMPILED-ON-SAME-SOURCE 92864 . 94654)) (94850 102196 (CDBROWSER -94860 . 98787) (CDBROWSER.STRINGS 98789 . 102194)) (102358 104094 (CD.TABLEITEM 102368 . 102588) ( -CD.TABLEITEM.PRINTFN 102590 . 102789) (CD.TABLEITEM.COPYFN 102791 . 103849) ( -CDTABLEBROWSER.HEADING.REPAINTFN 103851 . 104092)) (104095 124750 (CDTABLEBROWSER.WHENSELECTEDFN -104105 . 104573) (CD.COMMANDSELECTEDFN 104575 . 109676) (CD-MENUFN 109678 . 113989) (CD-COMPARE-FILES -113991 . 117343) (CDBROWSER-COPY 117345 . 121014) (CDBROWSER-DELETE-FILE 121016 . 124229) (CD-SWAPDIRS - 124231 . 124748))))) +(CDFILES.PATS 29590 . 31865)) (31868 48910 (CDPRINT 31878 . 34395) (CDPRINT.HEADER 34397 . 35294) ( +CDPRINT.LINE 35296 . 38528) (CDPRINT.MAXWIDTHS 38530 . 42645) (CDPRINT.COLHEADERS 42647 . 43932) ( +CDPRINT.COLUMNS 43934 . 48275) (CDTEDIT 48277 . 48908)) (48911 57280 (CDMAP 48921 . 50353) (CDENTRY +50355 . 50664) (CDSUBSET 50666 . 52105) (CDMERGE 52107 . 55961) (CDMERGE.COMMON 55963 . 57278)) (57281 + 64819 (BINCOMP 57291 . 61580) (EOLTYPE 61582 . 64144) (EOLTYPE.SHOW 64146 . 64817)) (65347 77874 ( +FIND-UNCOMPILED-FILES 65357 . 69000) (FIND-UNSOURCED-FILES 69002 . 71386) (FIND-SOURCE-FILES 71388 . +73126) (FIND-COMPILED-FILES 73128 . 75005) (FIND-UNLOADED-FILES 75007 . 75860) (FIND-LOADED-FILES +75862 . 76290) (FIND-MULTICOMPILED-FILES 76292 . 77872)) (77875 86306 (CREATED-AS 77885 . 82682) ( +SOURCE-FOR-COMPILED-P 82684 . 85611) (COMPILE-SOURCE-DATE-DIFF 85613 . 86304)) (86307 96613 ( +FIX-DIRECTORY-DATES 86317 . 89310) (FIX-EQUIV-DATES 89312 . 90837) (COPY-COMPARED-FILES 90839 . 92660) + (COPY-MISSING-FILES 92662 . 94819) (COMPILED-ON-SAME-SOURCE 94821 . 96611)) (96807 104153 (CDBROWSER +96817 . 100744) (CDBROWSER.STRINGS 100746 . 104151)) (104315 106051 (CD.TABLEITEM 104325 . 104545) ( +CD.TABLEITEM.PRINTFN 104547 . 104746) (CD.TABLEITEM.COPYFN 104748 . 105806) ( +CDTABLEBROWSER.HEADING.REPAINTFN 105808 . 106049)) (106052 126707 (CDTABLEBROWSER.WHENSELECTEDFN +106062 . 106530) (CD.COMMANDSELECTEDFN 106532 . 111633) (CD-MENUFN 111635 . 115946) (CD-COMPARE-FILES +115948 . 119300) (CDBROWSER-COPY 119302 . 122971) (CDBROWSER-DELETE-FILE 122973 . 126186) (CD-SWAPDIRS + 126188 . 126705))))) STOP diff --git a/lispusers/COMPAREDIRECTORIES.LCOM b/lispusers/COMPAREDIRECTORIES.LCOM index e13ca9fc..f5c00c66 100644 Binary files a/lispusers/COMPAREDIRECTORIES.LCOM and b/lispusers/COMPAREDIRECTORIES.LCOM differ diff --git a/lispusers/GITFNS b/lispusers/GITFNS index acb7fcf3..a9ef67b1 100644 --- a/lispusers/GITFNS +++ b/lispusers/GITFNS @@ -1,13 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 9-Jul-2022 19:01:45"  -{DSK}kaplan>Local>medley3.5>working-medley>lispusers>GITFNS.;397 109555 +(FILECREATED "17-Jul-2022 11:13:13"  +{DSK}kaplan>Local>medley3.5>working-medley>lispusers>GITFNS.;418 112329 - :CHANGES-TO (FNS GIT-PRC-MENU GIT-COMMAND-TO-FILE) - (COMMANDS prc) + :CHANGES-TO (FNS GIT-PULL-REQUESTS GIT-BRANCH-DIFF PROCESS-COMMAND) - :PREVIOUS-DATE " 8-Jul-2022 10:37:36" -{DSK}kaplan>local>medley3.5>working-medley>lispusers>GITFNS.;390) + :PREVIOUS-DATE "16-Jul-2022 22:22:54" +{DSK}kaplan>local>medley3.5>working-medley>lispusers>GITFNS.;414) (PRETTYCOMPRINT GITFNSCOMS) @@ -102,7 +101,8 @@ (* ;; "Utilities") - (FNS CDGITDIR GIT-COMMAND GITORIGIN GIT-INITIALS GIT-COMMAND-TO-FILE) + (FNS CDGITDIR GIT-COMMAND GITORIGIN GIT-INITIALS GIT-COMMAND-TO-FILE PROCESS-COMMAND + GIT-RESULT-TO-LINES) (PROPS (GITFNS FILETYPE)))) @@ -147,6 +147,7 @@ (GIT-MAKE-PROJECT [LAMBDA (PROJECTNAME PROJECTPATH WORKINGPATH EXCLUSIONS DEFAULTSUBDIRS) + (* ; "Edited 13-Jul-2022 13:47 by rmk") (* ; "Edited 6-Jul-2022 19:34 by rmk") (* ; "Edited 17-May-2022 17:08 by rmk") (* ; "Edited 13-May-2022 10:40 by rmk") @@ -169,7 +170,7 @@ (* ;; "WORKINGPATH T or NIL means try to find a parallel to the projectpath, T means don't cause an error if not found. ") - (SETQ PROJECTNAME (U-CASE PROJECTNAME)) + (SETQ PROJECTNAME (U-CASE (MKATOM PROJECTNAME))) (CL:WHEN (MEMB PROJECTPATH '(NIL T)) [SETQ PROJECTPATH (OR (GIT-CLONEP (UNIX-GETENV PROJECTNAME) T) @@ -956,6 +957,8 @@ (GIT-BRANCH-DIFF [LAMBDA (BRANCH1 BRANCH2 PROJECT) + (* ;; "Edited 17-Jul-2022 09:36 by rmk") + (* ;; "Edited 4-Jun-2022 20:43 by rmk") (* ;; "Edited 9-May-2022 16:21 by rmk: returns an ALIST that classifies how the files in BRANCH1 and BRANCH2 differ (changed, renamed, added, deleted, copied).") @@ -972,51 +975,79 @@  (GIT-COMMAND (CONCAT  "git diff-tree --no-commit-id --name-STATUS -r "  COMMIT) NIL NIL PROJECT)) - (LET (POS (LINES (GIT-COMMAND (CONCAT "git diff --name-status -C --find-copies-harder " BRANCH1 - " " BRANCH2) - NIL NIL PROJECT))) - (CL:WHEN (SETQ POS (STRPOS "fatal: ambiguous argument '" (CAR LINES) - 1 NIL T T)) - (ERROR "Unknown branch " (IF (STRPOS BRANCH1 (CAR LINES) - POS NIL T) - THEN BRANCH1 - ELSE BRANCH2))) - (SORT (FOR L IN LINES - COLLECT (SELCHARQ (CHCON1 L) - (A (CL:IF (EQ (CHARCODE TAB) - (NTHCHARCODE L 2)) - (LIST 'ADDED (SUBSTRING L 3)) - (ERROR "ADDED NOT RECOGNIZED" L))) - (D (CL:IF (EQ (CHARCODE TAB) - (NTHCHARCODE L 2)) - (LIST 'DELETED (SUBSTRING L 3)) - (ERROR "DELETED NOT RECOGNIZED" L))) - (M (CL:IF (SETQ POS (STRPOS " " L)) - (LIST 'CHANGED (SUBSTRING L (ADD1 POS))) - (ERROR "CHANGED NOT RECOGNIZED" L))) - (C (IF (AND (EQ (CHARCODE TAB) - (NTHCHARCODE L 5)) - (SETQ POS (STRPOS " " L 7))) - THEN (LIST 'COPIED (SUBSTRING L 6 (SUB1 POS)) - (OR (FIXP (SUBATOM L 2 4)) - (HELP "C without a number" L))) - ELSE (HELP "COPY NOT RECOGNIZED" L))) - (R (IF (AND (EQ (CHARCODE TAB) - (NTHCHARCODE L 5)) - (SETQ POS (STRPOS " " L 7))) - THEN (LIST 'RENAMED (SUBSTRING L 6 (SUB1 POS)) - (SUBSTRING L (ADD1 POS)) - (OR (FIXP (SUBATOM L 2 4)) - (HELP "R without a number" L))) - ELSE (HELP "RENAME NOT RECOGNIZED" L))) - (w (CL:UNLESS (STRPOS "warning: " L 1) - (HELP "UNRECOGNZED GIT LINE" L)) - (CL:UNLESS (EQ 'Y (ASKUSER NIL NIL (CONCAT L + + (* ;; "We don't use GIT-COMMAND because we want to deal with the warning messages here, to give the option of increasing the rename limit..") + + (PROG (POS LIMIT ERRORFILE RLINES ELINES RESULTFILE) + RETRY + (SETQ RESULTFILE (GIT-COMMAND-TO-FILE (CONCAT + "git diff --name-status -C --find-copies-harder " + BRANCH1 " " BRANCH2) + PROJECT)) + (SETQ ELINES NIL) + (SETQ RLINES NIL) + (CL:WHEN (LISTP RESULTFILE) + (SETQ ERRORFILE (CADR RESULTFILE)) + (SETQ ELINES (GIT-RESULT-TO-LINES ERRORFILE)) + (DELFILE ERRORFILE) + (SETQ RESULTFILE (CAR RESULTFILE))) + (SETQ RLINES (GIT-RESULT-TO-LINES RESULTFILE)) + (DELFILE RESULTFILE) + (CL:WHEN ELINES + (IF [AND (STRPOS "warning: inexact rename detection was skipped due to too many files." + (CAR ELINES) + 1) + (SETQ LIMIT (FIXP (SUBATOM (CADR ELINES) + (STRPOS " at least " (CADR ELINES) + 1 NIL NIL T) + (SUB1 (STRPOS " and retry " (CADR ELINES] + THEN (PRINTOUT T 3 "** For accurate branch differences, " + "diff.renameLimit must be increased") + (SELECTQ (AND LIMIT (ASKUSER NIL 'N (CONCAT + " Should I increase the global limit to " + (ADD LIMIT 1) + " and try again? "))) + (Y (GIT-COMMAND (CONCAT "git config --global diff.renameLimit " LIMIT) + NIL NIL PROJECT) + (GO RETRY)) + (ERROR "Incomplete branch differences" (LIST BRANCH1 BRANCH2))) + ELSE (FOR L IN ELINES DO (PRINTOUT T L T)))) + (RETURN (SORT (FOR L IN RLINES + COLLECT (SELCHARQ (CHCON1 L) + (A (CL:IF (EQ (CHARCODE TAB) + (NTHCHARCODE L 2)) + (LIST 'ADDED (SUBSTRING L 3)) + (ERROR "ADDED NOT RECOGNIZED" L))) + (D (CL:IF (EQ (CHARCODE TAB) + (NTHCHARCODE L 2)) + (LIST 'DELETED (SUBSTRING L 3)) + (ERROR "DELETED NOT RECOGNIZED" L))) + (M (CL:IF (SETQ POS (STRPOS " " L)) + (LIST 'CHANGED (SUBSTRING L (ADD1 POS))) + (ERROR "CHANGED NOT RECOGNIZED" L))) + (C (IF (AND (EQ (CHARCODE TAB) + (NTHCHARCODE L 5)) + (SETQ POS (STRPOS " " L 7))) + THEN (LIST 'COPIED (SUBSTRING L 6 (SUB1 POS)) + (OR (FIXP (SUBATOM L 2 4)) + (HELP "C without a number" L))) + ELSE (HELP "COPY NOT RECOGNIZED" L))) + (R (IF (AND (EQ (CHARCODE TAB) + (NTHCHARCODE L 5)) + (SETQ POS (STRPOS " " L 7))) + THEN (LIST 'RENAMED (SUBSTRING L 6 (SUB1 POS)) + (SUBSTRING L (ADD1 POS)) + (OR (FIXP (SUBATOM L 2 4)) + (HELP "R without a number" L))) + ELSE (HELP "RENAME NOT RECOGNIZED" L))) + (w (CL:UNLESS (STRPOS "warning: " L 1) + (HELP "UNRECOGNZED GIT LINE" L)) + (CL:UNLESS (EQ 'Y (ASKUSER NIL NIL (CONCAT L " Ignore remaining files? " - ))) - (ERROR!))) - (HELP "Unrecognized git-diff code %"" L "%""))) - T]) + ))) + (ERROR!))) + (HELP "Unrecognized git-diff code " L))) + T]) (GIT-COMMIT-DIFFS [LAMBDA (BRANCH1 BUTNOTBRANCH2 PROJECT) (* ; "Edited 26-Jun-2022 13:32 by rmk") @@ -1244,8 +1275,11 @@ T)))]) (GIT-PULL-REQUESTS - [LAMBDA (ALLINFO INCLUDEDRAFTS PROJECT) (* ; "Edited 9-May-2022 16:54 by rmk") + [LAMBDA (ALLINFO INCLUDEDRAFTS PROJECT) (* ; "Edited 17-Jul-2022 11:12 by rmk") + (* ; "Edited 9-May-2022 16:54 by rmk") (* ; "Edited 25-Feb-2022 09:26 by rmk") + (CL:UNLESS (EQ 0 (PROCESS-COMMAND "command -v gh")) + (ERROR "gh must be installed in order to enumerate pull requests:")) (FOR LINE TAB1 TAB2 TAB3 VAL IN (GIT-COMMAND "gh pr list" T NIL PROJECT) WHEN [AND (SETQ TAB1 (STRPOS " " LINE)) (SETQ TAB2 (STRPOS " " LINE (ADD1 TAB1))) @@ -1945,7 +1979,8 @@ " && "]) (GIT-COMMAND - [LAMBDA (CMD ALL NOERROR PROJECT) (* ; "Edited 8-Jul-2022 10:20 by rmk") + [LAMBDA (CMD ALL NOERROR PROJECT) (* ; "Edited 16-Jul-2022 13:06 by rmk") + (* ; "Edited 8-Jul-2022 10:20 by rmk") (* ; "Edited 7-May-2022 22:40 by rmk") (* ; "Edited 7-Oct-2021 11:15 by rmk:") @@ -1966,13 +2001,7 @@ (DELFILE (CADR RESULTFILE)) (SETQ RESULTFILE (CAR RESULTFILE))) (CL:WHEN RESULTFILE - (SETQ LINES (CL:WITH-OPEN-FILE (STREAM RESULTFILE :DIRECTION :INPUT :EXTERNAL-FORMAT - (SYSTEM-EXTERNALFORMAT)) - (BIND LINE UNTIL (EOFP STREAM) - WHEN [PROGN (SETQ LINE (CL:READ-LINE STREAM :EOF-ERROR-P NIL - :EOF-VALUE NIL)) - (OR ALL (NOT (STRPOS ".git" LINE 1 NIL T] COLLECT - LINE))) + (SETQ LINES (GIT-RESULT-TO-LINES RESULTFILE ALL)) (DELFILE RESULTFILE) (* ; "On tmp/, OK if we miss") LINES)]) @@ -2001,92 +2030,109 @@ (ERROR "INITIALS is not set"]) (GIT-COMMAND-TO-FILE - [LAMBDA (CMD PROJECT NOERROR) (* ; "Edited 9-Jul-2022 18:55 by rmk") + [LAMBDA (CMD PROJECT NOERROR) (* ; "Edited 16-Jul-2022 10:09 by rmk") + (* ; "Edited 9-Jul-2022 18:55 by rmk") (* ; "Edited 8-Jul-2022 08:51 by rmk") (* ;; "Try to make the temporary name unique. Maybe Unix mktemp, except that we need to know the name that was used. So we calculate it, provide it, and assume that it worked. Caller an decide to delete it after examination. (Or, left to be reaped from /tmp/)") (SETQ PROJECT (GIT-GET-PROJECT PROJECT)) - (* ;; - "Filename of the form /tmp/medley-gitresult-{IDATE}-{rand} -- Avoid creating new unix directory") + (* ;; "Filename of the form /tmp/medley-gitresult-{IDATE}-{rand} ") (LET* ([PROJECTNAME (L-CASE (GIT-GET-PROJECT PROJECT 'PROJECTNAME] (DATE (IDATE)) (RAND (RAND)) (RESULTFILE (CONCAT "{UNIX}/tmp/" PROJECTNAME "-" DATE "-" RAND "-result")) (ERRORFILE (CONCAT "{UNIX}/tmp/" PROJECTNAME "-" DATE "-" RAND "-error")) - COMPLETED) - [CL:WITH-OPEN-STREAM (PS (CREATE-PROCESS-STREAM (CONCAT (CDGITDIR PROJECT) - CMD " > " (STRIPHOST RESULTFILE) - " 2> " - (STRIPHOST ERRORFILE) - " && echo COMPLETED "))) - (CLOSEF? ERRORFILE) - - (* ;; - "Avoid reading the process stream if there is another error signal. It ends to hang.") - - (SETQ COMPLETED (IF (AND (INFILEP ERRORFILE) - (IGREATERP (GETFILEINFO ERRORFILE 'LENGTH) - 0)) - THEN [CL:WITH-OPEN-FILE (ESTREAM ERRORFILE :DIRECTION :INPUT - :EXTERNAL-FORMAT ( - SYSTEM-EXTERNALFORMAT - )) - (OR (NEQ 0 (OR (FILEPOS "fatal: " ESTREAM 0 1) - (FILEPOS "gh: Command not found" - ESTREAM 0 1) - (FILEPOS "unknown command %"" ESTREAM - 0 1))) - (FILEPOS "' is not a git command." ESTREAM - (NCHARS CMD] - ELSE (SETFILEINFO PS 'ENDOFSTREAMOP (FUNCTION NILL)) - (STREQUAL "COMPLETED" (RSTRING PS] + COMPLETIONCODE) + [SETQ COMPLETIONCODE (PROCESS-COMMAND (CONCAT (CDGITDIR PROJECT) + CMD " > " (STRIPHOST RESULTFILE) + " 2> " + (STRIPHOST ERRORFILE] + (CLOSEF? ERRORFILE) (CLOSEF? RESULTFILE) - (IF COMPLETED - THEN (IF (IEQP 0 (GETFILEINFO ERRORFILE 'LENGTH)) - THEN (DELFILE ERRORFILE) - (SETQ ERRORFILE NIL) - ELSEIF (IEQP 0 (GETFILEINFO RESULTFILE 'LENGTH)) - THEN (SETQ RESULTFILE ERRORFILE) - (SETQ ERRORFILE NIL)) - (IF ERRORFILE + (CL:WHEN [AND (INFILEP ERRORFILE) + (IEQP 0 (GETFILEINFO ERRORFILE 'LENGTH] + (DELFILE ERRORFILE) + (SETQ ERRORFILE NIL)) + (CL:WHEN (AND (INFILEP RESULTFILE) + (IEQP 0 (GETFILEINFO RESULTFILE 'LENGTH)) + ERRORFILE) + (DELFILE RESULTFILE) (* ; + "Don't delete if the error file is also empty") + (SETQ RESULTFILE NIL)) + (CL:WHEN (AND (EQ COMPLETIONCODE 0) + ERRORFILE) (* ; + "Check the error file, just in case") + (CL:WITH-OPEN-FILE (ESTREAM ERRORFILE :DIRECTION :INPUT :EXTERNAL-FORMAT ( + SYSTEM-EXTERNALFORMAT + )) + (CL:WHEN (OR (EQ 0 (OR (FILEPOS "fatal: " ESTREAM 0 1) + (FILEPOS "gh: Command not found" ESTREAM 0 1) + (FILEPOS "unknown command %"" ESTREAM 0 1))) + (FILEPOS "' is not a git command." ESTREAM (NCHARS CMD))) + (SETQ COMPLETIONCODE 1)))) + (IF (EQ 0 COMPLETIONCODE) + THEN (IF (AND RESULTFILE ERRORFILE) THEN (LIST RESULTFILE ERRORFILE) - ELSE RESULTFILE) + ELSEIF RESULTFILE + ELSE ERRORFILE) ELSE (DELFILE RESULTFILE) (DELFILE ERRORFILE) - (IF NOERROR - THEN NIL - ELSE (ERROR (CONCAT "Command failed: " CMD]) + (CL:UNLESS NOERROR + (ERROR (CONCAT "Command failed: " CMD))) + NIL]) + +(PROCESS-COMMAND + [LAMBDA (CMD) (* ; "Edited 17-Jul-2022 08:17 by rmk") + + (* ;; "This sets up an asynchronous process and waits until it returns with an exit code. Typically 0 means success.") + + (CL:WITH-OPEN-STREAM (PS (CREATE-PROCESS-STREAM CMD)) + (BIND CODE WHILE (EQ T (SETQ CODE (OR (SUBRCALL UNIX-HANDLECOMM 7 (fetch (STREAM F1) + of PS)) + 0))) DO (BLOCK) FINALLY (RETURN CODE]) + +(GIT-RESULT-TO-LINES + [LAMBDA (FILE ALL) (* ; "Edited 16-Jul-2022 22:21 by rmk") + + (* ;; "Suppress .git lines unless ALL") + + (CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT :EXTERNAL-FORMAT (SYSTEM-EXTERNALFORMAT)) + (BIND LINE UNTIL (EOFP STREAM) WHEN [PROGN (SETQ LINE (CL:READ-LINE STREAM :EOF-ERROR-P + NIL :EOF-VALUE NIL)) + (OR ALL (NOT (STRPOS ".git" LINE 1] + COLLECT LINE]) ) (PUTPROPS GITFNS FILETYPE :TCOMPL) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3592 18006 (GIT-CLONEP 3602 . 4865) (GIT-MAKE-PROJECT 4867 . 12847) (GIT-GET-PROJECT -12849 . 14774) (GIT-PROJECT-PATH 14776 . 15820) (FIND-ANCESTOR-DIRECTORY 15822 . 16171) ( -GIT-FIND-CLONE 16173 . 17254) (GIT-MAINBRANCH 17256 . 17651) (GIT-MAINBRANCH? 17653 . 18004)) (24323 -27111 (ALLSUBDIRS 24333 . 25619) (MEDLEYSUBDIRS 25621 . 26314) (GITSUBDIRS 26316 . 27109)) (27112 -31902 (TOGIT 27122 . 28528) (FROMGIT 28530 . 29511) (GIT-DELETE-FILE 29513 . 30359) ( -MYMEDLEY-DELETE-FILES 30361 . 31900)) (31903 34435 (MYMEDLEYSUBDIR 31913 . 32369) (GITSUBDIR 32371 . -32814) (STRIPDIR 32816 . 33187) (STRIPHOST 33189 . 33429) (STRIPNAME 33431 . 34184) (STRIPWHERE 34186 - . 34433)) (34436 36338 (GFILE4MFILE 34446 . 34809) (MFILE4GFILE 34811 . 35380) (GIT-REPO-FILENAME -35382 . 36336)) (36387 46175 (GIT-COMMIT 36397 . 37223) (GIT-PUSH 37225 . 37869) (GIT-PULL 37871 . -38483) (GIT-APPROVAL 38485 . 38834) (GIT-GET-FILE 38836 . 40767) (GIT-FILE-EXISTS? 40769 . 41043) ( -GIT-REMOTE-UPDATE 41045 . 41769) (GIT-REMOTE-ADD 41771 . 42078) (GIT-FILE-DATE 42080 . 43011) ( -GIT-FILE-HISTORY 43013 . 44947) (GIT-PRINT-FILE-HISTORY 44949 . 45999) (GIT-FETCH 46001 . 46173)) ( -46205 54905 (GIT-BRANCH-DIFF 46215 . 50967) (GIT-COMMIT-DIFFS 50969 . 51522) (GIT-BRANCH-RELATIONS -51524 . 54903)) (54950 64659 (GIT-BRANCH-NUM 54960 . 55533) (GIT-CHECKOUT 55535 . 56594) ( -GIT-WHICH-BRANCH 56596 . 56894) (GIT-MAKE-BRANCH 56896 . 58640) (GIT-BRANCHES 58642 . 60240) ( -GIT-BRANCH-EXISTS? 60242 . 60946) (GIT-PICK-BRANCH 60948 . 61276) (GIT-PRC-MENU 61278 . 63026) ( -GIT-PULL-REQUESTS 63028 . 64045) (GIT-SHORT-BRANCH-NAME 64047 . 64338) (GIT-LONG-NAME 64340 . 64657)) -(64689 68024 (GIT-MY-CURRENT-BRANCH 64699 . 65069) (GIT-MY-BRANCHP 65071 . 65576) (GIT-MY-NEXT-BRANCH -65578 . 66072) (GIT-MY-BRANCHES 66074 . 68022)) (68070 72022 (GIT-ADD-WORKTREE 68080 . 69564) ( -GIT-REMOVE-WORKTREE 69566 . 70496) (GIT-LIST-WORKTREES 70498 . 71302) (WORKTREEDIR 71304 . 72020)) ( -72070 102052 (GIT-GET-DIFFERENT-FILES 72080 . 77905) (GIT-BRANCHES-COMPARE-DIRECTORIES 77907 . 83749) -(GIT-WORKING-COMPARE-DIRECTORIES 83751 . 88497) (GIT-COMPARE-WORKTREE 88499 . 92477) (GITCDOBJBUTTONFN - 92479 . 96969) (GIT-CD-LABELFN 96971 . 98053) (GIT-CD-MENUFN 98055 . 100262) ( -GIT-WORKING-COMPARE-FILES 100264 . 100884) (GIT-BRANCHES-COMPARE-FILES 100886 . 102050)) (102122 -109488 (CDGITDIR 102132 . 102692) (GIT-COMMAND 102694 . 104702) (GITORIGIN 104704 . 105401) ( -GIT-INITIALS 105403 . 105707) (GIT-COMMAND-TO-FILE 105709 . 109486))))) + (FILEMAP (NIL (3626 18158 (GIT-CLONEP 3636 . 4899) (GIT-MAKE-PROJECT 4901 . 12999) (GIT-GET-PROJECT +13001 . 14926) (GIT-PROJECT-PATH 14928 . 15972) (FIND-ANCESTOR-DIRECTORY 15974 . 16323) ( +GIT-FIND-CLONE 16325 . 17406) (GIT-MAINBRANCH 17408 . 17803) (GIT-MAINBRANCH? 17805 . 18156)) (24475 +27263 (ALLSUBDIRS 24485 . 25771) (MEDLEYSUBDIRS 25773 . 26466) (GITSUBDIRS 26468 . 27261)) (27264 +32054 (TOGIT 27274 . 28680) (FROMGIT 28682 . 29663) (GIT-DELETE-FILE 29665 . 30511) ( +MYMEDLEY-DELETE-FILES 30513 . 32052)) (32055 34587 (MYMEDLEYSUBDIR 32065 . 32521) (GITSUBDIR 32523 . +32966) (STRIPDIR 32968 . 33339) (STRIPHOST 33341 . 33581) (STRIPNAME 33583 . 34336) (STRIPWHERE 34338 + . 34585)) (34588 36490 (GFILE4MFILE 34598 . 34961) (MFILE4GFILE 34963 . 35532) (GIT-REPO-FILENAME +35534 . 36488)) (36539 46327 (GIT-COMMIT 36549 . 37375) (GIT-PUSH 37377 . 38021) (GIT-PULL 38023 . +38635) (GIT-APPROVAL 38637 . 38986) (GIT-GET-FILE 38988 . 40919) (GIT-FILE-EXISTS? 40921 . 41195) ( +GIT-REMOTE-UPDATE 41197 . 41921) (GIT-REMOTE-ADD 41923 . 42230) (GIT-FILE-DATE 42232 . 43163) ( +GIT-FILE-HISTORY 43165 . 45099) (GIT-PRINT-FILE-HISTORY 45101 . 46151) (GIT-FETCH 46153 . 46325)) ( +46357 57089 (GIT-BRANCH-DIFF 46367 . 53151) (GIT-COMMIT-DIFFS 53153 . 53706) (GIT-BRANCH-RELATIONS +53708 . 57087)) (57134 67092 (GIT-BRANCH-NUM 57144 . 57717) (GIT-CHECKOUT 57719 . 58778) ( +GIT-WHICH-BRANCH 58780 . 59078) (GIT-MAKE-BRANCH 59080 . 60824) (GIT-BRANCHES 60826 . 62424) ( +GIT-BRANCH-EXISTS? 62426 . 63130) (GIT-PICK-BRANCH 63132 . 63460) (GIT-PRC-MENU 63462 . 65210) ( +GIT-PULL-REQUESTS 65212 . 66478) (GIT-SHORT-BRANCH-NAME 66480 . 66771) (GIT-LONG-NAME 66773 . 67090)) +(67122 70457 (GIT-MY-CURRENT-BRANCH 67132 . 67502) (GIT-MY-BRANCHP 67504 . 68009) (GIT-MY-NEXT-BRANCH +68011 . 68505) (GIT-MY-BRANCHES 68507 . 70455)) (70503 74455 (GIT-ADD-WORKTREE 70513 . 71997) ( +GIT-REMOVE-WORKTREE 71999 . 72929) (GIT-LIST-WORKTREES 72931 . 73735) (WORKTREEDIR 73737 . 74453)) ( +74503 104485 (GIT-GET-DIFFERENT-FILES 74513 . 80338) (GIT-BRANCHES-COMPARE-DIRECTORIES 80340 . 86182) +(GIT-WORKING-COMPARE-DIRECTORIES 86184 . 90930) (GIT-COMPARE-WORKTREE 90932 . 94910) (GITCDOBJBUTTONFN + 94912 . 99402) (GIT-CD-LABELFN 99404 . 100486) (GIT-CD-MENUFN 100488 . 102695) ( +GIT-WORKING-COMPARE-FILES 102697 . 103317) (GIT-BRANCHES-COMPARE-FILES 103319 . 104483)) (104555 +112262 (CDGITDIR 104565 . 105125) (GIT-COMMAND 105127 . 106685) (GITORIGIN 106687 . 107384) ( +GIT-INITIALS 107386 . 107690) (GIT-COMMAND-TO-FILE 107692 . 111036) (PROCESS-COMMAND 111038 . 111651) +(GIT-RESULT-TO-LINES 111653 . 112260))))) STOP diff --git a/lispusers/GITFNS.LCOM b/lispusers/GITFNS.LCOM index 5be3dd42..2e26b497 100644 Binary files a/lispusers/GITFNS.LCOM and b/lispusers/GITFNS.LCOM differ diff --git a/lispusers/GITFNS.TEDIT b/lispusers/GITFNS.TEDIT index 6f5856c2..c8a10257 100644 --- a/lispusers/GITFNS.TEDIT +++ b/lispusers/GITFNS.TEDIT @@ -58,6 +58,7 @@ This compares the files in branch1 and branch2, for example bbc rmk15 lmm12 (local) This will compare the files in origin/rmk15 and origin/lmm12 in the GIT-DEFAULT project. branch1 defaults to the origin files of the currently checked out branch, the second defaults to origin/master. If local is non-NIL, then a branch that has neither local/ or origin/ prepended will default to local (e.g. local/rmk15) instead of origin/. Local refers to the files that are currently in the clone directory, which may not be the same as the origin files, depending on the push/pull status. Either of the branches can be specified with an atom LOCAL, REMOTE, or ORIGIN, in which case bbc will offer menus listing the currently existing branches of that type. +NOTE: Branch comparison makes use of a git command that has a limit (diff.renameLimit) on the number of files that it can successfully compare. A message will be printed if that limit is exceeded, asking whether a larger value for that limit should be applied globally. The command cob ("check out branch") checks out a specified branch: cob branch (nexttitlestring) (project) [command] @@ -89,6 +90,6 @@ TIMESROMAN$TERMINALMODERN   HRULE.GETFNMODERN    HRULE.GETFNMODERN   HRULE.GETFNMODERN   ,  R   ; B1 L-.$w a       / 27#h     n      ( 'G  !    =c    5  3 $   - ,  I     )1          < 5f  & 0   %9"?  M  s  I  ""       w 6 D l  BZ D + ,  I     )1          < 5H -  & 0   %9"?  M  s  I  ""       w 6 D l  BZ D  D -. (  2   D   Uf -< D  z D  -5z \ No newline at end of file +< D  z D  .Dz \ No newline at end of file diff --git a/lispusers/UPCSTATS b/obsolete/lispusers/UPCSTATS similarity index 100% rename from lispusers/UPCSTATS rename to obsolete/lispusers/UPCSTATS diff --git a/lispusers/upcstats.tedit b/obsolete/lispusers/UPCSTATS.TEDIT similarity index 100% rename from lispusers/upcstats.tedit rename to obsolete/lispusers/UPCSTATS.TEDIT diff --git a/sources/MAKEINIT b/sources/MAKEINIT index 85e18265..3f939a04 100644 --- a/sources/MAKEINIT +++ b/sources/MAKEINIT @@ -1,11 +1,12 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS) -(FILECREATED "19-Jul-2021 23:50:29"  -{DSK}kaplan>Local>medley3.5>git-medley>sources>MAKEINIT.;4 54410 +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) - changes to%: (FNS MKI.PASSFILE) +(FILECREATED "11-Jul-2022 20:00:23"  +{DSK}kaplan>local>medley3.5>working-medley>sources>MAKEINIT.;3 54607 - previous date%: "17-Jul-2021 21:29:31" -{DSK}kaplan>Local>medley3.5>git-medley>sources>MAKEINIT.;3) + :CHANGES-TO (FNS I.FIXUPNUM I.FIXUPSYM) + + :PREVIOUS-DATE "19-Jul-2021 23:50:29" +{DSK}kaplan>local>medley3.5>working-medley>sources>MAKEINIT.;2) (* ; " @@ -17,7 +18,7 @@ Copyright (c) 1982-1988, 1990-1992, 1998, 2021 by Venue & Xerox Corporation. (RPAQQ MAKEINITCOMS ((COMS -(* ;;; "From MAKEINITGREET") +(* ;;; "From MAKEINITGREET") (FNS MAKEINITGREET) (FILES (SOURCE) @@ -26,11 +27,11 @@ Copyright (c) 1982-1988, 1990-1992, 1998, 2021 by Venue & Xerox Corporation. LLARITH LLFLOAT) (FILES RENAMEFNS XCL-PACKAGE CMLARRAY-SUPPORT VMEM)) (COMS - (* ;; "From original MAKEINIT") + (* ;; "From original MAKEINIT") (FNS LOADMAKEINIT LOADMKIFILES RELOAD MAKEINIT MKI.START) - (COMS (* ; - "reading compiled files and processing well-known expressions") + (COMS (* ; + "reading compiled files and processing well-known expressions") (FNS MKI.PASSFILE SCRATCHARRAY DOFORM CONSTFORMP NOTICECOMS EVALFORMAKEINIT) (FNS I.ADDTOVAR I.DECLARE%: I.DEFINE-FILE-INFO I.FILECREATED I.PUTPROPS I.RPAQ I.RPAQQ I.RPAQ? I.SETTOPVAL I.NOUNDO) @@ -38,10 +39,10 @@ Copyright (c) 1982-1988, 1990-1992, 1998, 2021 by Venue & Xerox Corporation. RPAQQ LISPXPRINT PRETTYCOMPRINT * SETTOPVAL SETQQ SETQ /SETTOPVAL)) (FNS I.ATOMNUMBER I.\ATOMCELL I.FIXUPNUM I.FIXUPPTR I.FIXUPSYM I.WORDSPERNAMEENTRY I.SETSTKNTOFFSET) - (COMS (* ; "stuff for MAXC") + (COMS (* ; "stuff for MAXC") (FNS MKI.ATOM MKI.IEEE)) - [COMS (* ; - "stuff to maintain symbol values, prop lists during makeinit--all dumped at end.") + [COMS (* ; + "stuff to maintain symbol values, prop lists during makeinit--all dumped at end.") (FNS MKI.DSET MKI.ADDTO MKI.PUTPROP) (VARS (MKI.ARRAY) (MKI.TVHA (HASHARRAY 400)) @@ -60,10 +61,10 @@ Copyright (c) 1982-1988, 1990-1992, 1998, 2021 by Venue & Xerox Corporation. (FILES (LOADCOMP) MEM))) (COMS - (* ;; "from DLFIXINIT") + (* ;; "from DLFIXINIT") - (* ;; " This file is all because the dandelion needed its microcode embedded in the init file, and MAIKO wasn't around. So this is all to make room for microcode we don't need. Except something(?) might expect the %"InterfacePage%" as page 2 of the file, so we're leaving it in place now") + (* ;; " This file is all because the dandelion needed its microcode embedded in the init file, and MAIKO wasn't around. So this is all to make room for microcode we don't need. Except something(?) might expect the %"InterfacePage%" as page 2 of the file, so we're leaving it in place now") (FNS DLFIXINIT DLSORTSYSOUTPAGES DLNEXTFP DLLOCKEDPAGEP DLSETLOCKBIT DLCOPYPAGEMAP DLCOPYVMPAGE DLADDPAGEMAPENTRIES ASSIGNFILEPAGE ASSIGNFILEPAGERANGE DLDUMPSYSOUT @@ -401,9 +402,10 @@ Copyright (c) 1982-1988, 1990-1992, 1998, 2021 by Venue & Xerox Corporation. (I.ADDBASE ATOMNO OFFSET]) (I.FIXUPNUM - [LAMBDA (CA BN NUM MASK) (* ; "Edited 17-Jul-90 14:28 by jds") + [LAMBDA (CA BN NUM MASK) (* ; "Edited 11-Jul-2022 20:00 by rmk") + (* ; "Edited 17-Jul-90 14:28 by jds") - (* ;; "2Perform atom-number fixup for a code block.") + (* ;; "Perform atom-number fixup for a code block.") (COND ((FMEMB :3-BYTE COMPILER::*TARGET-ARCHITECTURE*) @@ -437,9 +439,10 @@ Copyright (c) 1982-1988, 1990-1992, 1998, 2021 by Venue & Xerox Corporation. (I.HILOC PTR]) (I.FIXUPSYM - [LAMBDA (CA BN NUM MASK) (* ; "Edited 23-Jan-91 19:04 by jds") + [LAMBDA (CA BN NUM MASK) (* ; "Edited 11-Jul-2022 20:00 by rmk") + (* ; "Edited 23-Jan-91 19:04 by jds") - (* ;; "2Perform SYMBOL fixup for a code block.") + (* ;; "Perform SYMBOL fixup for a code block.") (COND ((FMEMB :3-BYTE COMPILER::*TARGET-ARCHITECTURE*) @@ -578,11 +581,11 @@ Copyright (c) 1982-1988, 1990-1992, 1998, 2021 by Venue & Xerox Corporation. (DECLARE%: EVAL@COMPILE (PUTPROPS SETXVAR MACRO [X `(SETQ.NOREF %, (CADAR X) - %, - (CADR X]) + %, + (CADR X]) (PUTPROPS IEQ MACRO ((X Y) - (IEQP X Y))) + (IEQP X Y))) DONTCOPY (FILESLOAD (LOADCOMP) @@ -1053,25 +1056,25 @@ DONTCOPY (PUTPROPS MAKEINIT COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1990 1991 1992 1998 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3966 4713 (MAKEINITGREET 3976 . 4711)) (4896 11281 (LOADMAKEINIT 4906 . 6109) ( -LOADMKIFILES 6111 . 6426) (RELOAD 6428 . 6911) (MAKEINIT 6913 . 10573) (MKI.START 10575 . 11279)) ( -11359 17077 (MKI.PASSFILE 11369 . 14979) (SCRATCHARRAY 14981 . 15630) (DOFORM 15632 . 16309) ( -CONSTFORMP 16311 . 16545) (NOTICECOMS 16547 . 16855) (EVALFORMAKEINIT 16857 . 17075)) (17078 19198 ( -I.ADDTOVAR 17088 . 17182) (I.DECLARE%: 17184 . 17460) (I.DEFINE-FILE-INFO 17462 . 17652) ( -I.FILECREATED 17654 . 18028) (I.PUTPROPS 18030 . 18143) (I.RPAQ 18145 . 18366) (I.RPAQQ 18368 . 18564) - (I.RPAQ? 18566 . 18781) (I.SETTOPVAL 18783 . 19015) (I.NOUNDO 19017 . 19196)) (19834 25834 ( -I.ATOMNUMBER 19844 . 20335) (I.\ATOMCELL 20337 . 22090) (I.FIXUPNUM 22092 . 22909) (I.FIXUPPTR 22911 - . 23392) (I.FIXUPSYM 23394 . 24342) (I.WORDSPERNAMEENTRY 24344 . 25099) (I.SETSTKNTOFFSET 25101 . -25832)) (25866 27374 (MKI.ATOM 25876 . 26072) (MKI.IEEE 26074 . 27372)) (27471 28236 (MKI.DSET 27481 - . 27764) (MKI.ADDTO 27766 . 27951) (MKI.PUTPROP 27953 . 28234)) (28410 28962 (DUMPVP 28420 . 28517) ( -BOUTZEROS 28519 . 28598) (BIN16 28600 . 28781) (BOUT16 28783 . 28960)) (29877 52611 (DLFIXINIT 29887 - . 30862) (DLSORTSYSOUTPAGES 30864 . 35990) (DLNEXTFP 35992 . 36329) (DLLOCKEDPAGEP 36331 . 36545) ( -DLSETLOCKBIT 36547 . 36809) (DLCOPYPAGEMAP 36811 . 39862) (DLCOPYVMPAGE 39864 . 40254) ( -DLADDPAGEMAPENTRIES 40256 . 41071) (ASSIGNFILEPAGE 41073 . 42306) (ASSIGNFILEPAGERANGE 42308 . 42715) -(DLDUMPSYSOUT 42717 . 44469) (DLDUMPFPTOVP 44471 . 45510) (DLDUMPPAGEMAPS 45512 . 46212) ( -DLDUMPVMEMPAGES 46214 . 46870) (DLSETBOOTPTR 46872 . 47102) (DLDUMPARRAY 47104 . 47491) ( -DLMARKASDUMPED 47493 . 47946) (DLDUMPVMEMPAGE 47948 . 48636) (INSTALLDOMINO 48638 . 49285) ( -INSTALLDOMINO.DIRECT 49287 . 50439) (INSTALLNEWDOMINO 50441 . 52609)) (52633 53990 (DLPRINTFPTOVP -52643 . 52932) (PRINTPRIMARYMAP 52934 . 53648) (DLREADPAGEOFWORDS 53650 . 53817) (SETDIF 53819 . 53988 + (FILEMAP (NIL (3971 4718 (MAKEINITGREET 3981 . 4716)) (4901 11286 (LOADMAKEINIT 4911 . 6114) ( +LOADMKIFILES 6116 . 6431) (RELOAD 6433 . 6916) (MAKEINIT 6918 . 10578) (MKI.START 10580 . 11284)) ( +11364 17082 (MKI.PASSFILE 11374 . 14984) (SCRATCHARRAY 14986 . 15635) (DOFORM 15637 . 16314) ( +CONSTFORMP 16316 . 16550) (NOTICECOMS 16552 . 16860) (EVALFORMAKEINIT 16862 . 17080)) (17083 19203 ( +I.ADDTOVAR 17093 . 17187) (I.DECLARE%: 17189 . 17465) (I.DEFINE-FILE-INFO 17467 . 17657) ( +I.FILECREATED 17659 . 18033) (I.PUTPROPS 18035 . 18148) (I.RPAQ 18150 . 18371) (I.RPAQQ 18373 . 18569) + (I.RPAQ? 18571 . 18786) (I.SETTOPVAL 18788 . 19020) (I.NOUNDO 19022 . 19201)) (19839 26055 ( +I.ATOMNUMBER 19849 . 20340) (I.\ATOMCELL 20342 . 22095) (I.FIXUPNUM 22097 . 23022) (I.FIXUPPTR 23024 + . 23505) (I.FIXUPSYM 23507 . 24563) (I.WORDSPERNAMEENTRY 24565 . 25320) (I.SETSTKNTOFFSET 25322 . +26053)) (26087 27595 (MKI.ATOM 26097 . 26293) (MKI.IEEE 26295 . 27593)) (27692 28457 (MKI.DSET 27702 + . 27985) (MKI.ADDTO 27987 . 28172) (MKI.PUTPROP 28174 . 28455)) (28631 29183 (DUMPVP 28641 . 28738) ( +BOUTZEROS 28740 . 28819) (BIN16 28821 . 29002) (BOUT16 29004 . 29181)) (30074 52808 (DLFIXINIT 30084 + . 31059) (DLSORTSYSOUTPAGES 31061 . 36187) (DLNEXTFP 36189 . 36526) (DLLOCKEDPAGEP 36528 . 36742) ( +DLSETLOCKBIT 36744 . 37006) (DLCOPYPAGEMAP 37008 . 40059) (DLCOPYVMPAGE 40061 . 40451) ( +DLADDPAGEMAPENTRIES 40453 . 41268) (ASSIGNFILEPAGE 41270 . 42503) (ASSIGNFILEPAGERANGE 42505 . 42912) +(DLDUMPSYSOUT 42914 . 44666) (DLDUMPFPTOVP 44668 . 45707) (DLDUMPPAGEMAPS 45709 . 46409) ( +DLDUMPVMEMPAGES 46411 . 47067) (DLSETBOOTPTR 47069 . 47299) (DLDUMPARRAY 47301 . 47688) ( +DLMARKASDUMPED 47690 . 48143) (DLDUMPVMEMPAGE 48145 . 48833) (INSTALLDOMINO 48835 . 49482) ( +INSTALLDOMINO.DIRECT 49484 . 50636) (INSTALLNEWDOMINO 50638 . 52806)) (52830 54187 (DLPRINTFPTOVP +52840 . 53129) (PRINTPRIMARYMAP 53131 . 53845) (DLREADPAGEOFWORDS 53847 . 54014) (SETDIF 54016 . 54185 ))))) STOP diff --git a/sources/MAKEINIT.LCOM b/sources/MAKEINIT.LCOM index 6bcbefd3..9342cf53 100644 Binary files a/sources/MAKEINIT.LCOM and b/sources/MAKEINIT.LCOM differ