From 8bfbe99367b55aecbd5bbc21b247d826fc9466b0 Mon Sep 17 00:00:00 2001 From: rmkaplan <69548581+rmkaplan@users.noreply.github.com> Date: Fri, 13 May 2022 12:50:16 -0700 Subject: [PATCH] Rmk38: Added git "projects" to GITFNS, plus minor updates to directory/source comparisons (#771) * SETSTRINGLENGTH.TEDIT: Orphan TEDIT file, no code in lispusers It will be restored when the code it goes with is moved over from LFG * COMPAREDIRECTORIES: minor fix * COMPARESOURCES: Add IGNORECOMMENTS flag * GITFNS: Add new "project" capability for multiple clones The TEDIT file got smashed, so new features are not yet documented. Should work as before for the Medley project. If you set up unix variables LOOPS or NOTECARDS to point to their local clones (or just name the clones git-loops or git-notecards as sisters to your MEDLEYDIR), you should be able to do prc loops or prc notecards. * Update GITFNS.TEDIT Repaired the Tedit smash * EDITINTERFACE: All date comments at the same comment level * EDITINTERFACE: Improved date alignment * GITFNS again: added cdg and cdw commands --- lispusers/COMPAREDIRECTORIES | 59 +- lispusers/COMPAREDIRECTORIES.LCOM | Bin 40396 -> 40192 bytes lispusers/COMPARESOURCES | 62 +- lispusers/COMPARESOURCES.LCOM | Bin 17450 -> 17455 bytes lispusers/GITFNS | 1494 +++++++++++++++++------------ lispusers/GITFNS.LCOM | Bin 32559 -> 39766 bytes lispusers/GITFNS.TEDIT | 96 +- lispusers/SetStringLength.Tedit | Bin 5450 -> 0 bytes sources/EDITINTERFACE | 139 +-- sources/EDITINTERFACE.LCOM | Bin 16456 -> 16487 bytes 10 files changed, 1108 insertions(+), 742 deletions(-) delete mode 100644 lispusers/SetStringLength.Tedit diff --git a/lispusers/COMPAREDIRECTORIES b/lispusers/COMPAREDIRECTORIES index 4c1cc920..a00a8f22 100644 --- a/lispusers/COMPAREDIRECTORIES +++ b/lispusers/COMPAREDIRECTORIES @@ -1,14 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "25-Apr-2022 09:25:02"  -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;217 123829 +(FILECREATED " 9-May-2022 20:28:46"  +{DSK}kaplan>local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;218 123686 - :CHANGES-TO (FNS CDBROWSER-COPY COMPAREDIRECTORIES.INFOS.TYPE CDFILES FIND-UNSOURCED-FILES - FIND-SOURCE-FILES FIND-COMPILED-FILES FIND-UNLOADED-FILES FIND-LOADED-FILES - FIND-MULTICOMPILED-FILES SOURCE-FOR-COMPILED-P CDBROWSER-DELETE-FILE) + :CHANGES-TO (FNS SOURCE-FOR-COMPILED-P) - :PREVIOUS-DATE "29-Mar-2022 11:53:34" -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;215) + :PREVIOUS-DATE "25-Apr-2022 09:25:02" +{DSK}kaplan>local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;217) (* ; " @@ -1376,7 +1374,8 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp (LIST SOURCENAME (GDATE (IDATE SOURCEDATE))))]) (SOURCE-FOR-COMPILED-P - [LAMBDA (SOURCE COMPILED DFASLMARGIN) (* ; "Edited 25-Apr-2022 08:46 by rmk") + [LAMBDA (SOURCE COMPILED DFASLMARGIN) (* ; "Edited 9-May-2022 20:28 by rmk") + (* ; "Edited 25-Apr-2022 08:46 by rmk") (* ; "Edited 31-Oct-2020 09:12 by rmk:") (* ;; "There seems to be some variation between the source dates in dfasl files and the filecreated date in the sources, they often don't match exactly. But if they are within DFASLMARGIN, we assume a match. We require exact date match for LCOMS") @@ -1416,8 +1415,8 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp (CADDR COMPILED)) (EQUAL (CADR SOURCE) (CADDDR COMPILED)) - (AND [STREQUAL 'DFASL (U-CASE (FILENAMEFIELD.STRING (CAR COMPILED) - 'EXTENSION] + (AND (STRING.EQUAL 'DFASL (FILENAMEFIELD.STRING (CAR COMPILED) + 'EXTENSION)) (LET ((TIMEDIFF (COMPILE-SOURCE-DATE-DIFF COMPILED SOURCE))) (* ;; "If compiled was no more than 20 minutes later, it's probably OK. Of no more than DFASLMARGIN earlier, if it is negative.") @@ -2096,24 +2095,24 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp (PUTPROPS COMPAREDIRECTORIES COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1994 1998 2018 2020 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2856 22205 (COMPAREDIRECTORIES 2866 . 7699) (COMPAREDIRECTORIES.INFOS 7701 . 10552) ( -COMPAREDIRECTORIES.CANDIDATES 10554 . 13939) (CDENTRIES.SELECT 13941 . 18716) ( -COMPAREDIRECTORIES.INFOS.TYPE 18718 . 19439) (MATCHNAME 19441 . 20121) (CD.INSURECDVALUE 20123 . 21737 -) (CD.UPDATEWIDTHS 21739 . 22203)) (22206 31875 (CDFILES 22216 . 27969) (CDFILES.MATCH 27971 . 29596) -(CDFILES.PATS 29598 . 31873)) (31876 46961 (CDPRINT 31886 . 34231) (CDPRINT.HEADER 34233 . 35130) ( -CDPRINT.LINE 35132 . 37688) (CDPRINT.MAXWIDTHS 37690 . 41805) (CDPRINT.COLHEADERS 41807 . 42445) ( -CDPRINT.COLUMNS 42447 . 46326) (CDTEDIT 46328 . 46959)) (46962 55331 (CDMAP 46972 . 48404) (CDENTRY -48406 . 48715) (CDSUBSET 48717 . 50156) (CDMERGE 50158 . 54012) (CDMERGE.COMMON 54014 . 55329)) (55332 - 62870 (BINCOMP 55342 . 59631) (EOLTYPE 59633 . 62195) (EOLTYPE.SHOW 62197 . 62868)) (63398 75925 ( -FIND-UNCOMPILED-FILES 63408 . 67051) (FIND-UNSOURCED-FILES 67053 . 69437) (FIND-SOURCE-FILES 69439 . -71177) (FIND-COMPILED-FILES 71179 . 73056) (FIND-UNLOADED-FILES 73058 . 73911) (FIND-LOADED-FILES -73913 . 74341) (FIND-MULTICOMPILED-FILES 74343 . 75923)) (75926 84255 (CREATED-AS 75936 . 80733) ( -SOURCE-FOR-COMPILED-P 80735 . 83560) (COMPILE-SOURCE-DATE-DIFF 83562 . 84253)) (84256 94562 ( -FIX-DIRECTORY-DATES 84266 . 87259) (FIX-EQUIV-DATES 87261 . 88786) (COPY-COMPARED-FILES 88788 . 90609) - (COPY-MISSING-FILES 90611 . 92768) (COMPILED-ON-SAME-SOURCE 92770 . 94560)) (94756 102102 (CDBROWSER -94766 . 98693) (CDBROWSER.STRINGS 98695 . 102100)) (102264 104000 (CD.TABLEITEM 102274 . 102494) ( -CD.TABLEITEM.PRINTFN 102496 . 102695) (CD.TABLEITEM.COPYFN 102697 . 103755) ( -CDTABLEBROWSER.HEADING.REPAINTFN 103757 . 103998)) (104001 123245 (CDTABLEBROWSER.WHENSELECTEDFN -104011 . 104479) (CD.COMMANDSELECTEDFN 104481 . 109582) (CD-MENUFN 109584 . 115947) (CDBROWSER-COPY -115949 . 119509) (CDBROWSER-DELETE-FILE 119511 . 122724) (CD-SWAPDIRS 122726 . 123243))))) + (FILEMAP (NIL (2611 21960 (COMPAREDIRECTORIES 2621 . 7454) (COMPAREDIRECTORIES.INFOS 7456 . 10307) ( +COMPAREDIRECTORIES.CANDIDATES 10309 . 13694) (CDENTRIES.SELECT 13696 . 18471) ( +COMPAREDIRECTORIES.INFOS.TYPE 18473 . 19194) (MATCHNAME 19196 . 19876) (CD.INSURECDVALUE 19878 . 21492 +) (CD.UPDATEWIDTHS 21494 . 21958)) (21961 31630 (CDFILES 21971 . 27724) (CDFILES.MATCH 27726 . 29351) +(CDFILES.PATS 29353 . 31628)) (31631 46716 (CDPRINT 31641 . 33986) (CDPRINT.HEADER 33988 . 34885) ( +CDPRINT.LINE 34887 . 37443) (CDPRINT.MAXWIDTHS 37445 . 41560) (CDPRINT.COLHEADERS 41562 . 42200) ( +CDPRINT.COLUMNS 42202 . 46081) (CDTEDIT 46083 . 46714)) (46717 55086 (CDMAP 46727 . 48159) (CDENTRY +48161 . 48470) (CDSUBSET 48472 . 49911) (CDMERGE 49913 . 53767) (CDMERGE.COMMON 53769 . 55084)) (55087 + 62625 (BINCOMP 55097 . 59386) (EOLTYPE 59388 . 61950) (EOLTYPE.SHOW 61952 . 62623)) (63153 75680 ( +FIND-UNCOMPILED-FILES 63163 . 66806) (FIND-UNSOURCED-FILES 66808 . 69192) (FIND-SOURCE-FILES 69194 . +70932) (FIND-COMPILED-FILES 70934 . 72811) (FIND-UNLOADED-FILES 72813 . 73666) (FIND-LOADED-FILES +73668 . 74096) (FIND-MULTICOMPILED-FILES 74098 . 75678)) (75681 84112 (CREATED-AS 75691 . 80488) ( +SOURCE-FOR-COMPILED-P 80490 . 83417) (COMPILE-SOURCE-DATE-DIFF 83419 . 84110)) (84113 94419 ( +FIX-DIRECTORY-DATES 84123 . 87116) (FIX-EQUIV-DATES 87118 . 88643) (COPY-COMPARED-FILES 88645 . 90466) + (COPY-MISSING-FILES 90468 . 92625) (COMPILED-ON-SAME-SOURCE 92627 . 94417)) (94613 101959 (CDBROWSER +94623 . 98550) (CDBROWSER.STRINGS 98552 . 101957)) (102121 103857 (CD.TABLEITEM 102131 . 102351) ( +CD.TABLEITEM.PRINTFN 102353 . 102552) (CD.TABLEITEM.COPYFN 102554 . 103612) ( +CDTABLEBROWSER.HEADING.REPAINTFN 103614 . 103855)) (103858 123102 (CDTABLEBROWSER.WHENSELECTEDFN +103868 . 104336) (CD.COMMANDSELECTEDFN 104338 . 109439) (CD-MENUFN 109441 . 115804) (CDBROWSER-COPY +115806 . 119366) (CDBROWSER-DELETE-FILE 119368 . 122581) (CD-SWAPDIRS 122583 . 123100))))) STOP diff --git a/lispusers/COMPAREDIRECTORIES.LCOM b/lispusers/COMPAREDIRECTORIES.LCOM index 82e57c687cac3f8517b6f9764a23747a190f4fe4..a7116590460d3f5b713736a6bf1e6b1eb03bcd8c 100644 GIT binary patch delta 374 zcmX@Jo2g+J(}Zvl1xsDu#7bQw10y2^BLgcV3o8?|iP@5TrNya5#dg_=1v!a%b~%%) z7%lZIG!>K-ERd8NS(%zx85=5bDI^u8Cgt6cwvlO;+>~ug}a=P;v|P z@lin5r>Ccz$W0#u95JaZ*YE)6$NA6MrfSH}=n7oZ|6Zd6j>s&)zXuC+mRXnt~H zj$LkQN=|B}v7YJV4n}P$3k5?XV>1gg1uJI{M?ZJhVBHXZ1r0a9U@o8&#RN1JtO9~u z!#w>%gLPei_D%L>l*jbF)n-Lz>qN$7lVek2Bz+y27#*3Im>9oobxLOd0!KzL#WneQ iiUp&=ko__9nu7RPBKARm=yDb3wLT4BN delta 478 zcmZutJxjw-6g6?t3=ZNaf?fiG6<$eROxrxQ7?ampj7@znu?Q~F7LnE(S_eTy9o#Dq z-24TO#YO*ui~q&R$@no8^)B~v?!AX|&efCr@+^0&W7tG?+(uZ#7&MDulW6$1F+CD? z>g`Ux5yj1@mG{K8WL;)cpkkx%JWEWCXojl5e!G5favUEu>ousK#qG{K0mofuew9;( z9KW&)M=ekbq31zAMLL~Up%$GcZ~swSYD!rslsxJ%Y7Yj~74OpAKhhSnpkpJ4Eg;T@ zT`p3N0v{F%Wv={|A^f4KOgh-D&}8#T&7n{#yC^JkKV%MdQ6KmX{UD0a?wAaU*k%*r z^=5oE1*F30PRS2Ba_xX77A&+C{e-FO#59Ppq=Itp^398tzllm_FOrud=|S8d?9H+@ zS+ZqWmfjwVhXYC3(pOVH=V38g%L(vjW^|kZ9x%Ec+Fs&XhY&e7r=aT@(Y>AQb!&0% E0}nBP$^ZZW diff --git a/lispusers/COMPARESOURCES b/lispusers/COMPARESOURCES index c38bd452..c6fd3d9c 100644 --- a/lispusers/COMPARESOURCES +++ b/lispusers/COMPARESOURCES @@ -1,13 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "25-Feb-2022 18:02:24"  -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>COMPARESOURCES.;121 41359 +(FILECREATED "12-May-2022 10:17:13"  +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>COMPARESOURCES.;123 41825 - :CHANGES-TO (FNS \CS.COMPARE.MASTERS \CS.COMPARE.TYPES \CS.REC.NAME \CS.ISRECFORM) - (VARS COMPARESOURCETYPES COMPARESOURCESCOMS) + :CHANGES-TO (FNS CSBROWSER) - :PREVIOUS-DATE "28-Jan-2022 18:22:40" -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>COMPARESOURCES.;118) + :PREVIOUS-DATE "11-May-2022 19:12:38" +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>COMPARESOURCES.;122) (* ; " @@ -38,7 +37,8 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation. (DEFINEQ (COMPARESOURCES - [LAMBDA (FILEX FILEY EXAMINE DW? LISTSTREAM) (* ; "Edited 28-Jan-2022 17:10 by rmk") + [LAMBDA (FILEX FILEY EXAMINE DW? LISTSTREAM IGNORECOMMENTS)(* ; "Edited 11-May-2022 19:12 by rmk") + (* ; "Edited 28-Jan-2022 17:10 by rmk") (* ; "Edited 26-Dec-2021 21:32 by rmk") (* ; "Edited 19-Apr-2018 10:49 by rmk:") @@ -74,6 +74,11 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation. (CL:MULTIPLE-VALUE-SETQ (BODYY ENVY) (READFILE FILEY)) (SETQ BODYY (\CS.FILTER.GARBAGE BODYY)) + (CL:WHEN IGNORECOMMENTS + (LET ((*REMOVE-INTERLISP-COMMENTS* T)) + (DECLARE (SPECVARS *REMOVE-INTERLISP-COMMENTS*)) + (SETQ BODYX (REMOVE-COMMENTS BODYX)) + (SETQ BODYY (REMOVE-COMMENTS BODYY)))) [SETQ DATECOL (PLUS 2 (CONSTANT (NCHARS "Comparing")) (IMAX (NCHARS FILEX) (NCHARS FILEY] @@ -629,7 +634,8 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation. (DEFINEQ (CSBROWSER - [LAMBDA (FILEX FILEY DW? LABEL1 LABEL2 REGION) + [LAMBDA (FILEX FILEY DW? LABEL1 LABEL2 REGION IGNORECOMMENTS) + (* ; "Edited 12-May-2022 10:16 by rmk") (* ;; "Edited 24-Jan-2022 23:11 by rmk: EXAMINE is non-NIL, we run the compare twice. Once to get the TEDIT up as a kind of table of contents, and the second time to run through all of the SEDIT windows.") @@ -640,12 +646,12 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation. (* ;; "Don't use the INFILEP value, because that might screw with capitalization that the caller prefers. If the file can be found that way, then lower functions will find it.") (DECLARE (SPECVARS LABEL1 LABEL2)) - (OR (INFILEP FILEX) - (SETQ FILEX (FINDFILE FILEX NIL DIRECTORIES)) - (ERROR "FILE NOT FOUND" FILEX)) - (OR (INFILEP FILEY) - (SETQ FILEY (FINDFILE FILEY NIL DIRECTORIES)) - (ERROR "FILE NOT FOUND" FILEY)) + (SETQ FILEX (OR (INFILEP FILEX) + (FINDFILE FILEX NIL DIRECTORIES) + (ERROR "FILE NOT FOUND" FILEX))) + (SETQ FILEY (OR (INFILEP FILEY) + (FINDFILE FILEY NIL DIRECTORIES) + (ERROR "FILE NOT FOUND" FILEY))) (CL:UNLESS (LISPSOURCEFILEP FILEX) (ERROR FILEX " is not a Medley source file")) (CL:UNLESS (LISPSOURCEFILEP FILEY) @@ -661,12 +667,12 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation. (GETPROMPTWINDOW WINDOW T) (WINDOWPROP WINDOW 'UNDERSCONTRUCTION NIL) (COMPARESOURCES FILEX FILEY '(T 2WINDOWS) - DW? WINDOW) + DW? WINDOW IGNORECOMMENTS) (OPENW WINDOW) WINDOW)) (TEDIT (LET ((TSTREAM (OPENTEXTSTREAM))) (DSPFONT DEFAULTFONT TSTREAM) - (COMPARESOURCES FILEX FILEY EXAMINE DW? TSTREAM) + (COMPARESOURCES FILEX FILEY EXAMINE DW? TSTREAM IGNORECOMMENTS) [TEDIT TSTREAM REGION NIL `(READONLY T WINDOWTYPE COMPARESOURCES-TEDIT TITLE ,TITLE] (CL:WHEN NIL @@ -693,16 +699,16 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation. ) (PUTPROPS COMPARESOURCES COPYRIGHT ("Xerox Corporation" 1985 1986 1987 1988 2018 2020 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1970 26690 (COMPARESOURCES 1980 . 8026) (\CS.COMPARE.MASTERS 8028 . 15440) ( -\CS.COMPARE.TYPES 15442 . 18708) (\CS.EXAMINE 18710 . 22937) (\CS.FIXFNS 22939 . 24441) ( -\CS.SORT.DECLARES 24443 . 24786) (\CS.SORT.DECLARE1 24788 . 26208) (\CS.FILTER.GARBAGE 26210 . 26688)) - (26691 31227 (\CS.ISFNFORM 26701 . 26969) (\CS.COMPARE.FNS 26971 . 27213) (\CS.FNSID 27215 . 27359) ( -\CS.ISVARFORM 27361 . 27466) (\CS.COMPARE.VARS 27468 . 28130) (\CS.ISMACROFORM 28132 . 28270) ( -\CS.ISRECFORM 28272 . 28600) (\CS.REC.NAME 28602 . 28921) (\CS.ISCOURIERFORM 28923 . 29023) ( -\CS.ISTEMPLATEFORM 29025 . 29123) (\CS.COMPARE.TEMPLATES 29125 . 29490) (\CS.ISPROPFORM 29492 . 29647) - (\CS.PROP.NAME 29649 . 29794) (\CS.COMPARE.PROPS 29796 . 29953) (\CS.ISADDVARFORM 29955 . 30048) ( -\CS.COMPARE.ADDVARS 30050 . 30215) (\CS.ISFPKGCOMFORM 30217 . 30424) (\CS.COMPARE.FPKGCOMS 30426 . -30633) (\CS.COMPARE.DEFINE-FILE-INFO 30635 . 31225)) (31228 37292 (CSOBJ.CREATE 31238 . 31651) ( -CSOBJ.DISPLAYFN 31653 . 32406) (CSOBJ.IMAGEBOXFN 32408 . 34569) (CSOBJ.BUTTONEVENTINFN 34571 . 37042) -(CSOBJ.COPYBUTTONEVENTINFN 37044 . 37290)) (38173 40877 (CSBROWSER 38183 . 40875))))) + (FILEMAP (NIL (1852 26954 (COMPARESOURCES 1862 . 8290) (\CS.COMPARE.MASTERS 8292 . 15704) ( +\CS.COMPARE.TYPES 15706 . 18972) (\CS.EXAMINE 18974 . 23201) (\CS.FIXFNS 23203 . 24705) ( +\CS.SORT.DECLARES 24707 . 25050) (\CS.SORT.DECLARE1 25052 . 26472) (\CS.FILTER.GARBAGE 26474 . 26952)) + (26955 31491 (\CS.ISFNFORM 26965 . 27233) (\CS.COMPARE.FNS 27235 . 27477) (\CS.FNSID 27479 . 27623) ( +\CS.ISVARFORM 27625 . 27730) (\CS.COMPARE.VARS 27732 . 28394) (\CS.ISMACROFORM 28396 . 28534) ( +\CS.ISRECFORM 28536 . 28864) (\CS.REC.NAME 28866 . 29185) (\CS.ISCOURIERFORM 29187 . 29287) ( +\CS.ISTEMPLATEFORM 29289 . 29387) (\CS.COMPARE.TEMPLATES 29389 . 29754) (\CS.ISPROPFORM 29756 . 29911) + (\CS.PROP.NAME 29913 . 30058) (\CS.COMPARE.PROPS 30060 . 30217) (\CS.ISADDVARFORM 30219 . 30312) ( +\CS.COMPARE.ADDVARS 30314 . 30479) (\CS.ISFPKGCOMFORM 30481 . 30688) (\CS.COMPARE.FPKGCOMS 30690 . +30897) (\CS.COMPARE.DEFINE-FILE-INFO 30899 . 31489)) (31492 37556 (CSOBJ.CREATE 31502 . 31915) ( +CSOBJ.DISPLAYFN 31917 . 32670) (CSOBJ.IMAGEBOXFN 32672 . 34833) (CSOBJ.BUTTONEVENTINFN 34835 . 37306) +(CSOBJ.COPYBUTTONEVENTINFN 37308 . 37554)) (38437 41343 (CSBROWSER 38447 . 41341))))) STOP diff --git a/lispusers/COMPARESOURCES.LCOM b/lispusers/COMPARESOURCES.LCOM index a786c4ae0d40da6469e39ef05889379a37d94495..c04448fe8eef990005d5e3cb96c0768373304d51 100644 GIT binary patch delta 2141 zcmZuyO>Ep$5RNx#)21!jrb*L+fRVM`ZUVd5&;N!)9Q$qR)a$p{PST&iDpe@0DiQ%{ zD^8I(Rfq$X@4b{05`r}32ILA70>PC-51bJd65>{vXRmjYYFDfE?9BJR_ukAm<1g+B zU)>WvTb__fy|wyLok)a$EZMSQ%gX&*D`%8x5W(!n2(dNQR^gGFZ11St~daTy;1L{W9NvH?npfjZJmo6?41ytE28rbdyC!D8o zJz-F5hB1uw&M*yjJEBWITa4=-@*$nvKelYyGO-nt)0GHGzb~Ebs4&xx{4lA{IWe7q zHsCfhcowhkAh{!P=7Jm{;~K}k=*(w-Wu3=cY>C#9hem-Px9cuzwP={c>E!U|&uQS# zhb*GGGyP`xjYGej9U3~E{xf_<_&05jObS1y*GJ6L^wH$alR`N-I)tBZTiN5SQ|W_| z?eh~%9Nr!NczfsxtBiNb0V|Jj&`Rs1+zUNrmGsV`*Yq<%%RR=Ud#s#OvGMHrU9cbi zGcx5Q8Atm2p*vf(JyzX4#cDU6?^HXLJtmeq;`Y-&S*_Zse*L$wCcMjepFHRc20rcs zgN%A-LO`m4;Qx*l;7&zoW$2Do-D4Gj<0~ar&Aydv$L!}g-@8-Yd)8BV$g1hl(HDeT zdTvxYTgmRqs@bDR1iwhSJ~}t6Yk&%&QB1+oOt?UUHX2gbP-I|p3k}EfT26R5Vas3< z3B2A4Nll-Op5C&|9*JqmecMz36@Y>Q)6jtnO9oR{3rjO##c8)`=n*hg1KhxlX;Sz6 zW|KxVbSap`D!{VQnEF9??$u<7oj7JL7?M_)y4*XNE*ae|G^;qHW?IE& z8r~s4xMq;T!bG_-PfXsXBcN$Y+Ii{4MNO4qo+iA5+eri(k$XIn+`p`9n6To;jhIDA z!=rBCL^KA~kOq16^smv=s;WrPaxT(3Z$=u`X}IJ^EaY8WNciR#Hz$j3)QQbcstKeP)a1-J~p+b zXwc2=IU5Yi0{Z5n6F4}L4NC<(p>YBRvi995(%h}<%D%Na&i_7>hML6MQ#V=mLl0X* z#f=73WkOLb$OPiEFq^(ax6-S}U)fSM5WS7{^P6yMed8{yUfa06nV%hBD<}dHu5Wzs z-iP(OlE)3haGm5`QJr5g!S zDj}groXU;r-H}j{kU#>`Z4aFC4*-G_$BGNLii$s=Ft*p5lHm! z`1Y>w#nN%2)f!hbyIu0dsxwVY^YJ^xz>PRgLlie`cBUU0%$8rKpA zXB%M*6-+<%QbgT)=rk!TyK&u*@wLICCWp6ASrwNxTTVn{wivlI#{diC`fM?- zd6*dUnzgx=PXF43*s6qi=S#B5&y~i{D=^iH{4lA_I5C}q7GQa%@X+3lLe3S5GZW+p z34I)Q-kGKRVd-mrbJ!^VG&VF;=HCoo8U52aFod7)og0<(xmtQS{MnY!lwTg}tA9n09GqeK{qo0~6Wgr% z=op*0ezIL{i`xuJZPW=3%o$zwPmcX=3@CpypBpGvhRH-+e zIKfb08hSsfsav~b84!S!08>)|pPQi!rb<#Vl@tw@omPv69s!eR;0AU~lbYu@8Z@Gz zOTmL4w#Aa>%IxuBcMl|t66{?Rm3>!r|)?2vdeO*e{Unl2Y+ zO)4ZTog1g6%1073MdrWlKfNhiFiVqkR$EB~s$~^XRKwc2s;cQ(9b*_x9b3O1t4v3vxRWk#)U)SeGS)P5jLmSN>Swx2}C)`YmqkYh3y zFcZ6ze{~sa{s+XVmjMK+xhD4jyr|9l$)L0%>Od(2n+mO(|P@HId${1aQ;ZXBOhGY zpDK?CrDQI1n07AC%pETCUrc*h$@h(-7_iicSksF^QPP1-8%Zpjkaplan>Local>medley3.5>my-medley>lispusers>GITFNS.;147 76981 +(FILECREATED "13-May-2022 10:51:44" {DSK}kaplan>Local>medley3.5>my-medley>lispusers>GITFNS.;278 95386 - :CHANGES-TO (FNS GIT-PRC-MENU) + :CHANGES-TO (COMMANDS cdg cdw) + (VARS GITFNSCOMS) - :PREVIOUS-DATE "29-Apr-2022 11:14:35" -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>GITFNS.;146) + :PREVIOUS-DATE "13-May-2022 10:45:15" +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>GITFNS.;277) (PRETTYCOMPRINT GITFNSCOMS) @@ -14,38 +15,32 @@ ( (* ;; "Set up") - (FILES (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES) + (FILES (SYSLOAD FROM LISPUSERS) COMPAREDIRECTORIES COMPARESOURCES COMPARETEXT PSEUDOHOSTS) - (* ;; "GITMEDLEYDIR and MYMEDLEYDIR collapse to MEDLEYDIR if not provided") + (* ;; "") - (INITVARS (GITMEDLEYDIR (SLASHIT (PACKFILENAME 'BODY (OR (UNIX-GETENV "GITMEDLEYDIR") - MEDLEYDIR) - 'HOST - 'UNIX) - T)) - (MYMEDLEYDIR (UNSLASHIT (PACKFILENAME 'BODY (OR (AND (BOUNDP 'MYMEDLEYDIR) - MYMEDLEYDIR) - (UNIX-GETENV "MYMEDLEYDIR") - MEDLEYDIR) - 'HOST - 'DSK) - T)) - (MYMEDLEYHOST 'MM) - (GITMEDLEYHOST 'GIT)) - (INITVARS (GIT-IGNORE-FILES '(EXPORTS.ALL RDSYS RDSYS.LCOM)) - (GIT-IGNORE-DIRECTORIES '(loadups patches tmp fontsold deleted clos cltl2)) - (GIT-MERGE-COMPARES T)) - (P (PSEUDOHOST MYMEDLEYHOST MYMEDLEYDIR) - (PSEUDOHOST GITMEDLEYHOST GITMEDLEYDIR)) - (FNS GIT-CLONEP) + + (* ;; "GIT projects") + + (COMS (FNS GIT-CLONEP GIT-MAKE-PROJECT GIT-GET-PROJECT GIT-PROJECT-PATH + FIND-ANCESTOR-DIRECTORY GIT-FIND-CLONE GIT-MAINBRANCH GIT-MAINBRANCH?) + (RECORDS GIT-PROJECT) + (INITVARS (GIT-DEFAULT-PROJECT 'MEDLEY) + (GIT-PROJECTS NIL))) + (P (GIT-MAKE-PROJECT 'MEDLEY T T '(EXPORTS.ALL RDSYS RDSYS.LCOM loadups/ patches/ tmp/ + fontsold/ clos/ cltl2/) + '(greetfiles scripts sources library lispusers)) + (GIT-MAKE-PROJECT 'NOTECARDS T T '(online/)) + (GIT-MAKE-PROJECT 'LOOPS T T)) (* ;; "") (* ;; "Lisp exec commands") - (COMMANDS gmc bbc prc cob b?) + (INITVARS (GIT-MERGE-COMPARES T)) + (COMMANDS gmc bbc prc cob b? cdg cdw) (* ;; "") @@ -54,7 +49,7 @@ (FNS ALLSUBDIRS MEDLEYSUBDIRS GITSUBDIRS) (FNS TOGIT FROMGIT GIT-DELETE-FILE MYMEDLEY-DELETE-FILES) - (FNS MYMEDLEYSUBDIR GITSUBDIR STRIPDIR STRIPHOST STRIPNAME) + (FNS MYMEDLEYSUBDIR GITSUBDIR STRIPDIR STRIPHOST STRIPNAME STRIPWHERE) (FNS GFILE4MFILE MFILE4GFILE GIT-REPO-FILENAME) (* ;; "") @@ -62,16 +57,20 @@ (* ;; "Git commands") - (FNS GIT-COMMIT GIT-PUSH GIT-PULL GIT-BRANCH-DIFF GIT-APPROVAL GIT-GET-FILE GIT-FILE-EXISTS? + (FNS GIT-COMMIT GIT-PUSH GIT-PULL GIT-APPROVAL GIT-GET-FILE GIT-FILE-EXISTS? GIT-REMOTE-UPDATE GIT-REMOTE-ADD GIT-FILE-DATE) + (* ;; "Differences") + + (FNS GIT-BRANCH-DIFF GIT-COMMIT-DIFFS GIT-BRANCH-RELATIONS) + (* ;; "") (* ;; "Branches") (FNS GIT-CHECKOUT GIT-WHICH-BRANCH GIT-MAKE-BRANCH GIT-BRANCHES GIT-BRANCH-EXISTS? - GIT-PICK-BRANCH GIT-PRC-MENU GIT-PULL-REQUESTS GIT-BRANCH-RELATIONS) + GIT-PICK-BRANCH GIT-PRC-MENU GIT-PULL-REQUESTS) (* ;; "My branches") @@ -105,65 +104,239 @@ (* ;; "Set up") -(FILESLOAD (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES) +(FILESLOAD (SYSLOAD FROM LISPUSERS) COMPAREDIRECTORIES COMPARESOURCES COMPARETEXT PSEUDOHOSTS) -(* ;; "GITMEDLEYDIR and MYMEDLEYDIR collapse to MEDLEYDIR if not provided") +(* ;; "") -(RPAQ? GITMEDLEYDIR (SLASHIT (PACKFILENAME 'BODY (OR (UNIX-GETENV "GITMEDLEYDIR") - MEDLEYDIR) - 'HOST - 'UNIX) - T)) -(RPAQ? MYMEDLEYDIR (UNSLASHIT (PACKFILENAME 'BODY (OR (AND (BOUNDP 'MYMEDLEYDIR) - MYMEDLEYDIR) - (UNIX-GETENV "MYMEDLEYDIR") - MEDLEYDIR) - 'HOST - 'DSK) - T)) -(RPAQ? MYMEDLEYHOST 'MM) +(* ;; "GIT projects") -(RPAQ? GITMEDLEYHOST 'GIT) - -(RPAQ? GIT-IGNORE-FILES '(EXPORTS.ALL RDSYS RDSYS.LCOM)) - -(RPAQ? GIT-IGNORE-DIRECTORIES '(loadups patches tmp fontsold deleted clos cltl2)) - -(RPAQ? GIT-MERGE-COMPARES T) - -(PSEUDOHOST MYMEDLEYHOST MYMEDLEYDIR) - -(PSEUDOHOST GITMEDLEYHOST GITMEDLEYDIR) (DEFINEQ (GIT-CLONEP - [LAMBDA (HOST/DIR NOERROR) (* ; "Edited 5-Feb-2022 11:35 by rmk") + [LAMBDA (HOST/DIR NOERROR CHECKANCESTORS) (* ; "Edited 12-May-2022 11:44 by rmk") + (* ; "Edited 8-May-2022 16:24 by rmk") - (* ;; - "Returns the canonical git pseudohost for HOST/DIR, NIL if it doesn't denote a git clone. ") + (* ;; "If CHECKANCESTORS, looks back up the directory chain to see if perhaps the .git is somewhere higher up.") - (CL:UNLESS HOST/DIR - (SETQ HOST/DIR '{GIT})) - (CL:UNLESS (EQ (CHARCODE {) - (CHCON1 HOST/DIR)) - (SETQ HOST/DIR (CONCAT "{" HOST/DIR "}"))) - (SETQ HOST/DIR (TRUEFILENAME HOST/DIR)) - (CL:UNLESS (MEMB (NTHCHARCODE HOST/DIR -1) - (CHARCODE (/ > < }))) - (SETQ HOST/DIR (CONCAT HOST/DIR "/"))) - (IF (DIRECTORYNAMEP (CONCAT HOST/DIR ".git/")) - THEN (PSEUDOFILENAME HOST/DIR) + (IF [AND HOST/DIR (LET ((D (SLASHIT (TRUEFILENAME (PACKFILENAME.STRING 'BODY HOST/DIR + 'HOST + 'DSK)) + T))) + (IF (DIRECTORYNAMEP (CONCAT D "/.git/")) + THEN D + ELSEIF (AND CHECKANCESTORS (FIND-ANCESTOR-DIRECTORY + D + (FUNCTION (LAMBDA (A) + (DIRECTORYNAMEP (CONCAT A + ".git/"] ELSEIF NOERROR THEN NIL - ELSE (ERROR (PSEUDOFILENAME HOST/DIR) - "is not a git clone"]) + ELSE (ERROR "NOT A GIT CLONE" HOST/DIR]) + +(GIT-MAKE-PROJECT + [LAMBDA (PROJECTNAME PROJECTPATH WORKINGPATH EXCLUSIONS DEFAULTSUBDIRS) + (* ; "Edited 13-May-2022 10:40 by rmk") + (* ; "Edited 12-May-2022 00:26 by rmk") + (* ; "Edited 9-May-2022 16:20 by rmk") + + (* ;; "PROJECTPATH must resolve to a git clone.") + + (* ;; "Search sequence for PROJECTPATH, if T or NIL") + + (* ;; " (UNIX-GETENV PROJECTNAME)") + + (* ;; " (UNIX-GETENV (CONCAT PROJECTNAME DIR)") + + (* ;; " git-PROJECTNAME sister of MEDLEYDIR ") + + (* ;; "If not found, error if NIL, return NIL if T ") + + (* ;; "") + + (* ;; "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)) + (CL:WHEN (MEMB PROJECTPATH '(NIL T)) + [SETQ PROJECTPATH (OR (GIT-CLONEP (UNIX-GETENV PROJECTNAME) + T) + (GIT-CLONEP (UNIX-GETENV (PACK* PROJECTNAME 'DIR)) + T) + (GIT-CLONEP (DIRECTORYNAME (CONCAT MEDLEYDIR "../git-" (L-CASE + PROJECTNAME + ) + "/")) + T) + (AND (NULL PROJECTPATH) + (ERROR (CONCAT "Can't a find clone directory for " PROJECTNAME]) + (CL:WHEN PROJECTPATH + (LET (CLONEPATH GITIGNORE PROJECT GITPATH WP) + (SETQ PROJECTPATH (SLASHIT (PACKFILENAME 'HOST 'UNIX 'DIRECTORY (UNPACKFILENAME.STRING + (TRUEFILENAME + PROJECTPATH) + 'DIRECTORY + 'RETURN)) + T)) + (SETQ CLONEPATH (IF (GIT-CLONEP PROJECTPATH T T) + ELSEIF (SETQ GITPATH (GIT-PROJECT-PATH PROJECTNAME PROJECTPATH)) + THEN (SETQ PROJECTPATH GITPATH) + (GIT-CLONEP PROJECTPATH NIL T) + ELSE (ERROR "Can't find GIT clone for" PROJECTPATH))) + (CL:WHEN (SETQ GITIGNORE (INFILEP (PACKFILENAME.STRING 'NAME ".gitignore" 'BODY + CLONEPATH))) + (SETQ GITIGNORE (CL:WITH-OPEN-FILE (STREAM GITIGNORE) + (BIND L UNTIL (EOFP STREAM) + WHILE (SETQ L (CL:READ-LINE STREAM :EOF-ERROR-P NIL + :EOF-VALUE NIL)) + UNLESS (OR (EQ 0 (NCHARS L)) + (STRPOS "#" L)) COLLECT L)))) + (SETQ EXCLUSIONS (CL:REMOVE-DUPLICATES (APPEND (FOR E INSIDE EXCLUSIONS + COLLECT (MKSTRING E)) + GITIGNORE + `("deleted/" "*.sysout")) + :TEST + (FUNCTION STRING.EQUAL))) + [SETQ WP + (DIRECTORYNAME (SELECTQ WORKINGPATH + ((T NIL) + (PACKFILENAME.STRING 'HOST 'DSK 'BODY + (CONCAT (SUBSTRING CLONEPATH 1 + (STRPOS "/" CLONEPATH -2 NIL NIL NIL + FILEDIRCASEARRAY T)) + "my-" + (OR (SUBSTRING PROJECTPATH + (OR (STRPOS CLONEPATH PROJECTPATH 1 + NIL NIL T FILEDIRCASEARRAY) + -2)) + (L-CASE PROJECTNAME)) + ">"))) + (TRUEFILENAME WORKINGPATH] + [SETQ WORKINGPATH (IF WP + THEN (UNSLASHIT WP T) + ELSEIF (EQ WORKINGPATH T) + THEN NIL + ELSE (ERROR (CONCAT "Can't find my working directory " + (OR WORKINGPATH "") + " for " PROJECTNAME] + (SETQ PROJECT (CREATE GIT-PROJECT + PROJECTNAME _ PROJECTNAME + GITHOST _ (PACK* "{" (PSEUDOHOST (CONCAT "G" PROJECTNAME) + PROJECTPATH) + "}") + WHOST _ (AND WORKINGPATH (PACK* "{" (PSEUDOHOST (CONCAT "W" + PROJECTNAME) + WP) + "}")) + EXCLUSIONS _ EXCLUSIONS + DEFAULTSUBDIRS _ (MKLIST DEFAULTSUBDIRS) + CLONEPATH _ CLONEPATH)) + (REPLACE MAINBRANCH OF PROJECT WITH (OR (GIT-BRANCH-EXISTS? 'origin/main T PROJECT) + (GIT-BRANCH-EXISTS? 'origin/master NIL PROJECT)) + ) + (/RPLACD [OR (ASSOC PROJECTNAME GIT-PROJECTS) + (CAR (PUSH GIT-PROJECTS (CONS PROJECTNAME] + PROJECT) + PROJECTNAME))]) + +(GIT-GET-PROJECT + [LAMBDA (PROJECT NOERROR FIELD) (* ; "Edited 13-May-2022 10:40 by rmk") + (* ; "Edited 9-May-2022 20:02 by rmk") + (* ; "Edited 8-May-2022 11:38 by rmk") + (CL:WHEN (SETQ PROJECT (IF (TYPE? GIT-PROJECT PROJECT) + THEN PROJECT + ELSEIF (CDR (ASSOC (OR (U-CASE PROJECT) + GIT-DEFAULT-PROJECT) + GIT-PROJECTS)) + ELSEIF NOERROR + THEN NIL + ELSE (ERROR "NOT A GIT-PROJECT" PROJECT))) + (SELECTQ FIELD + (PROJECTNAME (FETCH PROJECTNAME OF PROJECT)) + (WHOST (FETCH WHOST OF PROJECT)) + (GITHOST (FETCH GITHOST OF PROJECT)) + (EXCLUSIONS (FETCH EXCLUSIONS OF PROJECT)) + (DEFAULTSUBDIRS + (FETCH DEFAULTSUBDIRS OF PROJECT)) + (CLONEPATH (FETCH CLONEPATH OF PROJECT)) + (MAINBRANCH (FETCH MAINBRANCH OF PROJECT)) + PROJECT))]) + +(GIT-PROJECT-PATH + [LAMBDA (PROJECTNAME PROJECTPATH) (* ; "Edited 8-May-2022 15:10 by rmk") + + (* ;; "A project path must identify a clone. But it may be that a working path (with the convention %"my-%" is given instead of a %"git-%". So, this does a my- to git- string substitution, so that we can try again. Essentially a string-subst of /git-xxx/ for /my-xxx/ ") + + (SETQ PROJECTPATH (TRUEFILENAME PROJECTPATH)) + (CL:UNLESS (MEMB (NTHCHARCODE PROJECTPATH -1) + (CHARCODE (> /))) + (SETQ PROJECTPATH (CONCAT PROJECTPATH "/"))) + (LET (MY-POS (MYSUBDIR (CONCAT "/my-" PROJECTNAME "/"))) + (CL:WHEN (SETQ MY-POS (STRPOS MYSUBDIR PROJECTPATH 1 NIL NIL NIL FILEDIRCASEARRAY)) + (SLASHIT [CONCAT (SUBSTRING PROJECTPATH 1 MY-POS) + "git-" PROJECTNAME (SUBSTRING PROJECTPATH (IPLUS -1 MY-POS (NCHARS + MYSUBDIR] + T))]) + +(FIND-ANCESTOR-DIRECTORY + [LAMBDA (STARTDIR PREDFN) (* ; "Edited 8-May-2022 12:17 by rmk") + (BIND POS (A _ STARTDIR) WHILE (SETQ POS (STRPOS "/" A -2 NIL NIL NIL FILEDIRCASEARRAY T)) + DO (SETQ A (SUBSTRING A 1 POS)) + (CL:WHEN (APPLY* PREDFN A) + (RETURN A]) + +(GIT-FIND-CLONE + [LAMBDA (PROJECTNAME PROJECTPATH) (* ; "Edited 8-May-2022 15:00 by rmk") + + (* ;; "Maybe the PROJECTPATH was actually a MY path, in which case our best guess is that the git-clone is a sister somewhere above. ") + + (OR (GIT-CLONEP PROJECTPATH T T) + (GIT-CLONEP (GIT-PROJECT-PATH PROJECTNAME PROJECTPATH) + T T) + [FIND-ANCESTOR-DIRECTORY PROJECTPATH (FUNCTION (LAMBDA (A) + (BIND D (GEN _ (\GENERATEFILES A NIL NIL 1)) + WHILE (SETQ D (\GENERATENEXTFILE GEN)) + WHEN (GIT-CLONEP D T) + DO (RETFROM (FUNCTION + FIND-ANCESTOR-DIRECTORY) + D] + (ERROR "NOT A GIT CLONE" PROJECTPATH]) + +(GIT-MAINBRANCH + [LAMBDA (PROJECT LOCAL NOERROR) (* ; "Edited 9-May-2022 16:34 by rmk") + (LET [(MB (GIT-GET-PROJECT PROJECT NOERROR 'MAINBRANCH] + (CL:IF LOCAL + (CONCAT "local/" (STRIPWHERE MB)) + MB)]) + +(GIT-MAINBRANCH? + [LAMBDA (BRANCH PROJECT NOERROR) (* ; "Edited 9-May-2022 15:06 by rmk") + (IF (STRING.EQUAL (STRIPWHERE (GIT-MAINBRANCH PROJECT NIL T)) + (STRIPWHERE BRANCH)) + ELSEIF NOERROR + THEN NIL + ELSE (ERROR "Can't modify main branch" BRANCH]) ) +(DECLARE%: EVAL@COMPILE + +(TYPERECORD GIT-PROJECT (PROJECTNAME GITHOST WHOST EXCLUSIONS DEFAULTSUBDIRS CLONEPATH MAINBRANCH)) +) + +(RPAQ? GIT-DEFAULT-PROJECT 'MEDLEY) + +(RPAQ? GIT-PROJECTS NIL) + +(GIT-MAKE-PROJECT 'MEDLEY T T '(EXPORTS.ALL RDSYS RDSYS.LCOM loadups/ patches/ tmp/ fontsold/ clos/ + cltl2/) + '(greetfiles scripts sources library lispusers)) + +(GIT-MAKE-PROJECT 'NOTECARDS T T '(online/)) + +(GIT-MAKE-PROJECT 'LOOPS T T) @@ -175,47 +348,97 @@ (* ;; "Lisp exec commands") +(RPAQ? GIT-MERGE-COMPARES T) + (DEFCOMMAND gmc (SUBDIR . OTHERS) - (* ;; "Compares the specified local git-medley subdirectories against my working Medley. ") + (* ;; "Compares the specified local git-medley subdirectories against my working Medley. The SUBDIRS are the arguments up to one that looks like a project") - (GIT-COMPARE-WITH-MYMEDLEY (AND SUBDIR (CONS SUBDIR OTHERS)) - NIL NIL NIL NIL T)) + (LET ((SUBDIRS (AND SUBDIR (CONS SUBDIR OTHERS))) + PROJECT) + (SETQ SUBDIRS (FOR STAIL ON SUBDIRS COLLECT (IF (GIT-GET-PROJECT (CAR STAIL) + T) + THEN (SETQ PROJECT (CAR STAIL)) + (GO $$OUT)) + (CAR STAIL))) + (GIT-COMPARE-WITH-MYMEDLEY SUBDIRS NIL NIL NIL T PROJECT))) -(DEFCOMMAND bbc (BRANCH1 BRANCH2 LOCAL) +(DEFCOMMAND bbc (BRANCH1 BRANCH2 LOCAL PROJECT) - (* ;; "Compares 2 git branches. Defaults to local/ if LOCAL, otherwise defaults to origin/. BRANCH2 defaults to master (origin/ or local/ depending on LOCAL)") + (* ;; "Compares 2 git branches. Defaults to local/ if LOCAL, otherwise defaults to origin/. BRANCH2 defaults to the main branch (origin/ or local/ depending on LOCAL)") - (GIT-COMPARE-BRANCHES BRANCH1 BRANCH2 LOCAL)) + (SETQ PROJECT (GIT-GET-PROJECT PROJECT)) + (GIT-COMPARE-BRANCHES BRANCH1 (OR BRANCH (GIT-MAINBRANCH PROJECT LOCAL)) + LOCAL PROJECT)) -(DEFCOMMAND prc (REMOTEBRANCH DRAFTS) +(DEFCOMMAND prc (REMOTEBRANCH DRAFTS PROJECT) - (* ;; "Compares REMOTEBRANCH against origin/master, for pull-request assessment") + (* ;; "Compares REMOTEBRANCH against the main orign branch, for pull-request assessment") (LET ((RB REMOTEBRANCH) (DR DRAFTS)) + (IF PROJECT + THEN (SETQ PROOJECT (GIT-GET-PROJECT PROJECT)) + ELSEIF (GIT-GET-PROJECT RB T) + THEN (SETQ PROJECT RB) + (SETQ RB NIL) + ELSEIF (GIT-GET-PROJECT DRAFTS T) + THEN (SETQ PROJECT DRAFTS) + (SETQ DRAFTS NIL)) (CL:WHEN (MEMB (U-CASE RB) '(DRAFT DRAFTS)) (SETQ RB NIL) (SETQ DR T)) - (IF RB - THEN (GIT-COMPARE-BRANCHES RB 'origin/master) - ELSE (GIT-COMPARE-BRANCHES (GIT-PICK-BRANCH (OR (GIT-PRC-MENU DR) - 'REMOTE) - "Pull requests") - 'origin/master NIL)))) + (CL:WHEN (OR RB (SETQ RB (GIT-PICK-BRANCH (GIT-PRC-MENU DR PROJECT) + "Pull requests" NIL PROJECT))) + (GIT-COMPARE-BRANCHES RB (GIT-MAINBRANCH PROJECT) + NIL PROJECT)))) -(DEFCOMMAND cob (BRANCH) +(DEFCOMMAND cob (BRANCH PROJECT) (* ;; "Switches to BRANCH. T means my current branch, NEW/NEXT means my next branch (under wherever we are now). Default is to bring up a menu of locally available branches.") - [SELECTQ (U-CASE BRANCH) - (T (GIT-CHECKOUT (GIT-MY-CURRENT-BRANCH))) - ((NEW NEXT) - (GIT-MAKE-BRANCH)) - (GIT-CHECKOUT (OR BRANCH (GIT-PICK-BRANCH NIL "Branches" 'LOCAL]) + (CL:UNLESS PROJECT + (CL:WHEN (GIT-GET-PROJECT BRANCH T) + (SETQ PROJECT BRANCH) + (SETQ BRANCH NIL))) + (SETQ PROJECT (GIT-GET-PROJECT PROJECT)) + (SELECTQ (U-CASE BRANCH) + (T (GIT-CHECKOUT (GIT-MY-CURRENT-BRANCH PROJECT) + PROJECT)) + ((NEW NEXT) + (GIT-MAKE-BRANCH NIL NIL PROJECT)) + (GIT-CHECKOUT (OR BRANCH (GIT-PICK-BRANCH NIL (CONCAT (L-CASE (FETCH PROJECTNAME OF PROJECT) + T) + " branches") + 'LOCAL PROJECT)) + PROJECT))) -(DEFCOMMAND b? (BRANCH) (GIT-WHICH-BRANCH)) +(DEFCOMMAND b? (PROJECT) (SETQ PROJECT (GIT-GET-PROJECT PROJECT)) + (CONCAT (L-CASE (FETCH PROJECTNAME OF PROJECT) + T) + " " + (GIT-WHICH-BRANCH PROJECT))) + +(DEFCOMMAND cdg (PROJECT SUBDIR) (CL:UNLESS (GIT-GET-PROJECT PROJECT T 'GHOST) + (SETQ SUBDIR PROJECT) + (SETQ PROJECT GIT-DEFAULT-PROJECT)) + (CL:WHEN [AND SUBDIR (NOT (MEMB (CHCON1 SUBDIR)) + (CHARCODE (> /] + (SETQ SUBDIR (CONCAT SUBDIR "/"))) + (SLASHIT (/CNDIR (CONCAT (TRUEFILENAME (GIT-GET-PROJECT PROJECT NIL 'GITHOST)) + (OR SUBDIR ""))) + T)) + +(DEFCOMMAND cdw (PROJECT SUBDIR) (CL:UNLESS (GIT-GET-PROJECT PROJECT T) + (SETQ SUBDIR PROJECT) + (SETQ PROJECT GIT-DEFAULT-PROJECT)) + (CL:WHEN [AND SUBDIR (NOT (MEMB (CHCON1 SUBDIR)) + (CHARCODE (> /] + (SETQ SUBDIR (CONCAT SUBDIR "/"))) + (SLASHIT (/CNDIR (CONCAT (TRUEFILENAME (GIT-GET-PROJECT PROJECT NIL 'WHOST)) + (OR SUBDIR ""))) + T)) @@ -229,89 +452,104 @@ (DEFINEQ (ALLSUBDIRS - [LAMBDA (HOST1 HOST2) + [LAMBDA (PROJECT) + + (* ;; "Edited 13-May-2022 10:40 by rmk") + + (* ;; "Edited 10-May-2022 00:16 by rmk") (* ;; - "Edited 5-Mar-2022 09:42 by rmk: the union of the subdirectories that exist under all the hosts") + "Edited 7-May-2022 16:58 by rmk: the union of the subdirectories that exist in the project") - (* ;; "Returns the union of the subdirectories that exist under all the hosts") - - (LET ((HOSTS (MKLIST HOST1)) + (LET ((HOSTS (MKLIST (FETCH GITHOST OF PROJECT))) VAL) - (CL:WHEN HOST2 (PUSHNEW HOSTS HOST2)) - (CL:UNLESS HOSTS - (SETQ HOSTS (LIST MYMEDLEYHOST GITMEDLEYHOST))) + (CL:WHEN (FETCH WHOST OF PROJECT) + (PUSHNEW HOSTS (FETCH WHOST OF PROJECT))) (SORT (FOR H VAL IN HOSTS - JOIN (FOR F IN (FILDIR (PACKFILENAME 'HOST H 'BODY '*) - 1) WHEN (DIRECTORYNAMEP F) + JOIN (FOR F D IN (FILDIR (PACKFILENAME 'HOST H 'BODY '*) + 1) WHEN (DIRECTORYNAMEP F) UNLESS (OR [EQ (CHARCODE %.) (CHCON1 (SETQ D (FILENAMEFIELD F 'DIRECTORY] - (THEREIS SKIP IN GIT-IGNORE-DIRECTORIES + (THEREIS SKIP IN (FETCH EXCLUSIONS OF PROJECT) + FIRST (SETQ D (CONCAT D "/")) SUCHTHAT (STRPOS SKIP D 1 NIL T NIL FILEDIRCASEARRAY))) - DO (SETQ D (UNSLASHIT (L-CASE D))) + DO [SETQ D (UNSLASHIT (L-CASE (SUBSTRING D 1 -2] (CL:UNLESS (MEMBER D VAL) (PUSH VAL D))) FINALLY (RETURN VAL]) (MEDLEYSUBDIRS - [LAMBDA (MEDLEYHOST ALLSUBDIRS) (* ; "Edited 4-Feb-2022 18:06 by rmk") - (CL:UNLESS MEDLEYHOST (SETQ MEDLEYHOST MYMEDLEYHOST)) - (FOR D IN (OR ALLSUBDIRS (ALLSUBDIRS)) COLLECT (UNSLASHIT (PACKFILENAME 'HOST MEDLEYHOST - 'DIRECTORY D) - T]) + [LAMBDA (PROJECT ALLSUBDIRS) (* ; "Edited 13-May-2022 10:40 by rmk") + (* ; "Edited 7-May-2022 23:15 by rmk") + (FOR D IN (OR ALLSUBDIRS (ALLSUBDIRS PROJECT)) COLLECT (UNSLASHIT (PACKFILENAME 'HOST + (FETCH WHOST + OF PROJECT) + 'DIRECTORY D) + T]) (GITSUBDIRS - [LAMBDA (GITHOST ALLSUBDIRS) (* ; "Edited 4-Feb-2022 18:06 by rmk") - (CL:UNLESS GITHOST (SETQ GITHOST GITMEDLEYHOST)) - (FOR D IN (OR ALLSUBDIRS (ALLSUBDIRS)) COLLECT (SLASHIT (PACKFILENAME 'HOST GITHOST 'DIRECTORY D) - T]) + [LAMBDA (PROJECT ALLSUBDIRS) (* ; "Edited 10-May-2022 00:23 by rmk") + (* ; "Edited 7-May-2022 23:14 by rmk") + (* ; "Edited 4-Feb-2022 18:06 by rmk") + (FOR D IN (OR ALLSUBDIRS (ALLSUBDIRS PROJECT)) COLLECT (SLASHIT (PACKFILENAME 'HOST + (FETCH GITHOST + OF PROJECT) + 'DIRECTORY D) + T]) ) (DEFINEQ (TOGIT - [LAMBDA (MFILES) (* ; "Edited 4-Feb-2022 18:08 by rmk") - (* ; "Edited 2-Feb-2022 18:56 by rmk") - (* ; "Edited 19-Jan-2022 23:35 by rmk") - (* ; "Edited 18-Jan-2022 16:33 by rmk") - (* ; "Edited 13-Jan-2022 15:47 by rmk") + [LAMBDA (MFILES PROJECT) (* ; "Edited 10-May-2022 10:45 by rmk") + (* ; "Edited 7-May-2022 23:15 by rmk") + + (* ;; "Does anybody call this?") + + (SETQ PROJECT (GIT-GET-PROJECT PROJECT)) (* ;; "Copies MFILES to {GIT}. We do a sanity check to make sure particular MFILE is the latest version--we may have created another one without revising the directory browser.") - (CL:WHEN (STRPOS "master" (GIT-WHICH-BRANCH)) - (ERROR "Can't copy to the master branch")) - (FOR MF GF DEST INSIDE MFILES COLLECT (SETQ MF (OR (FINDFILE MF NIL (MEDLEYSUBDIRS)) - (ERROR "FILE NOT FOUND" MF))) - (CL:UNLESS (STRING.EQUAL MF (INFILEP (PACKFILENAME - 'VERSION NIL - 'BODY MF)) - FILEDIRCASEARRAY) - (FLASHWINDOW T) - (PRIN3 (CONCAT MF " is not the latest version!") - T) - (ERROR!)) - (SETQ GF (GFILE4MFILE MF)) - (PRIN3 (IF (SETQ DEST (COPYFILE MF GF)) - THEN (CONCAT "Copied to " GF) - ELSE (FLASHWINDOW T) - (CONCAT MF " cannot be copied")) - T) - DEST]) + (GIT-MAINBRANCH? (GIT-WHICH-BRANCH PROJECT) + PROJECT) + (FOR MF GF DEST (MEDLEYSUBDIRS _ (MEDLEYSUBDIRS PROJECT)) INSIDE MFILES + COLLECT (SETQ MF (OR (FINDFILE MF NIL MEDLEYSUBDIRS) + (ERROR "FILE NOT FOUND" MF))) + (CL:UNLESS (STRING.EQUAL MF (INFILEP (PACKFILENAME 'VERSION NIL 'BODY MF)) + FILEDIRCASEARRAY) + (FLASHWINDOW T) + (PRIN3 (CONCAT MF " is not the latest version!") + T) + (ERROR!)) + (SETQ GF (GFILE4MFILE MF PROJECT)) + (PRIN3 (IF (SETQ DEST (COPYFILE MF GF)) + THEN (CONCAT "Copied to " GF) + ELSE (FLASHWINDOW T) + (CONCAT MF " cannot be copied")) + T) + DEST]) (FROMGIT - [LAMBDA (GFILES) (* ; "Edited 4-Feb-2022 18:08 by rmk") + [LAMBDA (GFILES PROJECT) (* ; "Edited 10-May-2022 10:45 by rmk") + (* ; "Edited 4-Feb-2022 18:08 by rmk") (* ; "Edited 18-Jan-2022 16:31 by rmk") - (FOR GF MF DEST INSIDE GFILES COLLECT (SETQ GF (OR (FINDFILE GF NIL (GITSUBDIRS)) - (ERROR "FILE NOT FOUND" GF))) - (SETQ MF (MFILE4GFILE GF)) - (PRIN3 (IF (SETQ DEST (COPYFILE GF MF)) - THEN (CONCAT "Copied to " DEST) - DEST - ELSE (FLASHWINDOW T) - (CONCAT GF " cannot be copied")) - T) - DEST]) + + (* ;; "Does anybody call this?") + + (SETQ PROJECT (GIT-GET-PROJECT PROJECT)) + (FOR GF MF DEST (GITSUBDIRS _ (GITSUBDIRS PROJECT)) INSIDE GFILES + COLLECT (SETQ GF (OR (FINDFILE GF NIL GITSUBDIRS) + (ERROR "FILE NOT FOUND" GF))) + (SETQ MF (MFILE4GFILE GF)) + (PRIN3 (IF (SETQ DEST (COPYFILE GF MF)) + THEN (CONCAT "Copied to " DEST) + DEST + ELSE (FLASHWINDOW T) + (CONCAT GF " cannot be copied")) + T) + DEST]) (GIT-DELETE-FILE - [LAMBDA (FILE) (* ; "Edited 18-Jan-2022 23:07 by rmk") + [LAMBDA (FILE PROJECT) (* ; "Edited 8-May-2022 09:27 by rmk") + (* ; "Edited 18-Jan-2022 23:07 by rmk") (* ; "Edited 19-Dec-2021 16:11 by rmk") (* ; "Edited 16-Dec-2021 13:00 by rmk") @@ -321,21 +559,21 @@ (* ;; "We could make this undoable by copying it to deleted/, but git also can restore.") - (CL:UNLESS (OR (EQ GITMEDLEYHOST (FILENAMEFIELD FILE 'HOST)) - (STRPOS GITMEDLEYDIR FILE 1 NIL T NIL FILEDIRCASEARRAY)) - (ERROR "NOT A GIT-CLONE FILE" FILE)) + (GIT-CLONEP FILE NIL T) (DELFILE FILE]) (MYMEDLEY-DELETE-FILES - [LAMBDA (FILE) (* ; "Edited 18-Jan-2022 23:02 by rmk") - (* ; "Edited 19-Dec-2021 23:33 by rmk") + [LAMBDA (FILE PROJECT) (* ; "Edited 13-May-2022 10:40 by rmk") + (* ; "Edited 8-May-2022 23:31 by rmk") (* ;; "FILE is presumably the latest version of a file in the MyMedley directory, and we are presumably removing all versions of that file. If we left older versions, we would really trash ourselves.") (* ;; "But to guard against mistakes, %"deletion%" consists of moving all versions of the file from its current location to a deleted/ subdirectory of MEDLEYDIR, one that does not correspond to a git subdirectory.") - (SETQ FILE (CONTRACT.PH FILE MYMEDLEYHOST)) - (CL:WHEN (EQ MYMEDLEYHOST (FILENAMEFIELD FILE 'HOST)) + (SETQ FILE (CONTRACT.PH FILE (FETCH WHOST OF PROJECT))) + (CL:WHEN (EQ (FILENAMEFIELD (FETCH WHOST OF PROJECT) + 'HOST) + (FILENAMEFIELD FILE 'HOST)) (FOR F IN (DREVERSE (FILDIR (PACKFILENAME 'VERSION '* 'BODY FILE))) COLLECT @@ -352,17 +590,18 @@ (DEFINEQ (MYMEDLEYSUBDIR - [LAMBDA (SUBDIR STAR HOST) (* ; "Edited 26-Feb-2022 11:57 by rmk") - (* ; "Edited 21-Jan-2022 15:18 by rmk") - (UNSLASHIT (PACK* (PACKFILENAME 'HOST (OR HOST MYMEDLEYHOST) + [LAMBDA (SUBDIR STAR PROJECT) (* ; "Edited 13-May-2022 10:40 by rmk") + (* ; "Edited 7-May-2022 23:15 by rmk") + (UNSLASHIT (PACK* (PACKFILENAME 'HOST (FETCH WHOST OF PROJECT) 'DIRECTORY SUBDIR) (CL:IF STAR "*" "")]) (GITSUBDIR - [LAMBDA (SUBDIR STAR HOST) (* ; "Edited 26-Feb-2022 11:56 by rmk") - (SLASHIT (PACK* (PACKFILENAME 'HOST (OR HOST GITMEDLEYHOST) + [LAMBDA (SUBDIR STAR PROJECT) (* ; "Edited 7-May-2022 20:39 by rmk") + (* ; "Edited 26-Feb-2022 11:56 by rmk") + (SLASHIT (PACK* (PACKFILENAME 'HOST (FETCH GITHOST OF PROJECT) 'DIRECTORY SUBDIR) (CL:IF STAR "*" @@ -376,7 +615,7 @@ ELSE FILE]) (STRIPHOST - [LAMBDA (NAME) (* ; "Edited 18-Jan-2022 15:37 by rmk") + [LAMBDA (NAME) (* ; "Edited 18-Jan-2022 15:37 by rmk") (LET ((POS (STRPOS "}" NAME))) (CL:IF POS (SUBSTRING NAME (ADD1 POS)) @@ -396,30 +635,41 @@ (SUBSTRING FILE 1 LASTDIRPOS) FILE))) NIL]) + +(STRIPWHERE + [LAMBDA (BRANCH) (* ; "Edited 9-May-2022 14:31 by rmk") + (LET ((POS (STRPOS "/" BRANCH))) + (CL:IF POS + (SUBSTRING BRANCH (ADD1 POS)) + BRANCH)]) ) (DEFINEQ (GFILE4MFILE - [LAMBDA (MFILE GITHOST) (* ; "Edited 4-Feb-2022 18:04 by rmk") - (SLASHIT (PACKFILENAME 'HOST (OR GITHOST GITMEDLEYHOST) + [LAMBDA (MFILE PROJECT) (* ; "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) T]) (MFILE4GFILE - [LAMBDA (GFILE MHOST) (* ; "Edited 4-Feb-2022 18:04 by rmk") + [LAMBDA (GFILE PROJECT) (* ; "Edited 13-May-2022 10:40 by rmk") + (* ; "Edited 7-May-2022 23:20 by rmk") + (* ; "Edited 4-Feb-2022 18:04 by rmk") (* ; "Edited 18-Jan-2022 15:24 by rmk") - (UNSLASHIT (PACKFILENAME 'HOST (OR MHOST MYMEDLEYHOST) + (UNSLASHIT (PACKFILENAME 'HOST (FETCH WHOST OF PROJECT) 'VERSION NIL 'BODY GFILE]) (GIT-REPO-FILENAME - [LAMBDA (GFILE) (* ; "Edited 26-Feb-2022 12:25 by rmk") - (* ; "Edited 18-Jan-2022 15:42 by rmk") + [LAMBDA (GFILE PROJECT) (* ; "Edited 8-May-2022 23:35 by rmk") - (* ;; "Returns the string that the repo expects for a file name. {GIT} or GITMEDLEYDIR is stripped, brackets go to slashes, subdirectories are lower cased, an initial / and a final period is remove.") + (* ;; "Returns the string that the repo expects for a file name. The prefix is stripped, brackets go to slashes, subdirectories are lower cased, an initial / and a final period is remove.") - (SETQ GFILE (SLASHIT (IF (EQ GITMEDLEYHOST (FILENAMEFIELD GFILE 'HOST)) + (SETQ GFILE (SLASHIT [IF (EQ (FILENAMEFIELD (FETCH GITHOST OF PROJECT) + 'HOST) + (FILENAMEFIELD GFILE 'HOST)) THEN (STRIPHOST GFILE) - ELSE (STRIPDIR GFILE GITMEDLEYDIR)) + ELSE (STRIPDIR GFILE (TRUEFILENAME (FETCH GITHOST OF PROJECT] T)) (CL:WHEN (EQ (CHARCODE /) (CHCON1 GFILE)) @@ -442,51 +692,171 @@ (DEFINEQ (GIT-COMMIT - [LAMBDA (FILES TITLE MESSAGE) (* ; "Edited 16-Nov-2021 08:06 by rmk:") + [LAMBDA (FILES TITLE MESSAGE PROJECT) (* ; "Edited 9-May-2022 16:11 by rmk") + (* ; "Edited 16-Nov-2021 08:06 by rmk:") (* ; "Edited 2-Nov-2021 21:26 by rmk:") - (* ;; "Commits files that are already in the (non-master) current git branch.") + (* ;; "Commits files that are already in the (non-main) current git branch.") - (CL:WHEN (STREQUAL (GIT-WHICH-BRANCH) - "master") - (ERROR "Cannot commit to the master branch")) + (CL:WHEN (STRING.EQUAL (GIT-MAINBRANCH PROJECT) + (GIT-WHICH-BRANCH PROJECT)) + (ERROR "Cannot commit to the main branch")) + (HELP "UNIMPLEMENTED") + (GIT-MAINBRANCH? (GIT-WHICH-BRANCH PROJECT) + PROJECT) (LET (GFILES) - (SETQ GFILES (FOR F GF INSIDE FILES COLLECT (SETQ GF (INFILEP (GFILE4MFILE F]) + (SETQ GFILES (FOR F GF INSIDE FILES COLLECT (SETQ GF (INFILEP (GFILE4MFILE F PROJECT]) (GIT-PUSH - [LAMBDA (BRANCH) (* ; "Edited 8-Dec-2021 22:32 by rmk") - (* ; "Edited 16-Nov-2021 08:06 by rmk:") - (* ; "Edited 2-Nov-2021 21:34 by rmk:") + [LAMBDA (BRANCH PROJECT) (* ; "Edited 9-May-2022 15:06 by rmk") + (* ; "Edited 8-Dec-2021 22:32 by rmk") + (* ; "Edited 16-Nov-2021 08:06 by rmk:") + (* ; "Edited 2-Nov-2021 21:34 by rmk:") (CL:UNLESS BRANCH - (SETQ BRANCH (GIT-WHICH-BRANCH))) - (CL:WHEN (STREQUAL "master" (GIT-WHICH-BRANCH)) - (ERROR "Cannot push the master branch")) - (GIT-COMMAND (CONCAT "git push " BRANCH]) + (SETQ BRANCH (GIT-WHICH-BRANCH PROJECT))) + (GIT-MAINBRANCH? BRANCH PROJECT) + (GIT-COMMAND (CONCAT "git push " BRANCH) + NIL NIL PROJECT]) (GIT-PULL - [LAMBDA (BRANCH) (* ; "Edited 8-Dec-2021 22:47 by rmk") - (* ; "Edited 16-Nov-2021 08:06 by rmk:") - (* ; "Edited 2-Nov-2021 21:34 by rmk:") - (GIT-COMMAND (CONCAT "git pull " (OR BRANCH (GIT-WHICH-BRANCH]) + [LAMBDA (BRANCH PROJECT) (* ; "Edited 9-May-2022 15:07 by rmk") + (* ; "Edited 8-Dec-2021 22:47 by rmk") + (* ; "Edited 16-Nov-2021 08:06 by rmk:") + (* ; "Edited 2-Nov-2021 21:34 by rmk:") + (SETQ PROJECT (GIT-GET-PROJECT PROJECT)) + (GIT-COMMAND (CONCAT "git pull " (OR BRANCH (GIT-WHICH-BRANCH PROJECT))) + NIL NIL PROJECT]) + +(GIT-APPROVAL + [LAMBDA (BRANCH PROJECT) (* ; "Edited 9-May-2022 15:08 by rmk") + (* ; "Edited 19-Nov-2021 15:08 by rmk:") + (GIT-ADD-WORKTREE BRANCH T PROJECT) + (GIT-ADD-WORKTREE (GIT-MAINBRANCH PROJECT) + T]) + +(GIT-GET-FILE + [LAMBDA (BRANCH GITFILE LOCALFILE NOERROR PROJECT) + + (* ;; "Edited 8-May-2022 16:54 by rmk: the stream, not the name because of the NODIRCORE case.") + + (* ;; "Edited 6-Mar-2022 17:45 by rmk: the stream, not the name because of the NODIRCORE case.") + + (* ;; "Returns the stream, not the name because of the NODIRCORE case.") + + (* ;; "If GITFILE in (remote) BRANCH exists, it is copied to LOCALFILE and LOCALFILE is returned. If it doesn't exist, return value is NIL if NOERROR, otherwise an ERROR.") + + (CL:WHEN (AND BRANCH (STRPOS "local/" BRANCH 1 NIL T)) + (SETQ BRANCH (SUBSTRING BRANCH 7))) + (CL:WITH-OPEN-STREAM (s (CREATE-PROCESS-STREAM (CONCAT (CDGITDIR PROJECT) + "git show " BRANCH ":" GITFILE))) + (SETFILEINFO s 'ENDOFSTREAMOP (FUNCTION NILL)) + (LET (BYTES) + (IF (FOR I B C FROM 1 WHILE (SETQ C (NTHCHARCODE "fatal: " I)) + DO + (* ;; + "Returns NIL if we run off the fatal string with a match, otherwise T") + + (CL:UNLESS (SETQ B (\BIN s)) + (RETURN T)) + (PUSH BYTES B) + (CL:UNLESS (EQ B C) + (RETURN T))) + THEN + (* ;; "Don't open STREAM until we know the file is real") + + (CL:WITH-OPEN-FILE (STREAM (OR LOCALFILE '{NODIRCORE) + :IF-EXISTS :NEW-VERSION :DIRECTION :IO) + (FOR B IN (DREVERSE BYTES) DO (\BOUT STREAM B)) + [DO (\BOUT STREAM (OR (\BIN s) + (RETURN] + (SETFILEINFO STREAM 'CREATIONDATE (OR (FILEDATE STREAM T) + (FILEDATE STREAM) + (GIT-FILE-DATE GITFILE BRANCH + PROJECT))) + STREAM) + ELSEIF NOERROR + THEN NIL + ELSE (ERROR "GIT FILE NOT FOUND" GITFILE]) + +(GIT-FILE-EXISTS? + [LAMBDA (BRANCH GITFILE PROJECT) (* ; "Edited 8-May-2022 00:02 by rmk") + (* ; "Edited 6-Mar-2022 19:04 by rmk") + (* ; "Edited 10-Feb-2022 20:55 by rmk") + (* ; "Edited 10-Dec-2021 21:30 by rmk") + + (* ;; "T if GITFILE exists on BRANCH. If s is EOFP, the file exists but is empty") + + (CL:WITH-OPEN-STREAM (s (CREATE-PROCESS-STREAM (CONCAT (CDGITDIR PROJECT) + "git show " BRANCH ":" GITFILE))) + (SETFILEINFO s 'ENDOFSTREAMOP (FUNCTION NILL)) + (NOT (FOR I C FROM 1 WHILE (SETQ C (NTHCHARCODE "fatal: " I)) + ALWAYS (EQ (BIN s) + C]) + +(GIT-REMOTE-UPDATE + [LAMBDA (DOIT PROJECT) + (DECLARE (USEDFREE LAST-REMOTE-UPDATE-IDATE)) (* ; "Edited 7-May-2022 22:41 by rmk") + + (* ;; "Because git hangs on this (and other things), do this no more than once a day") + + (CL:WHEN [OR DOIT (NOT (BOUNDP 'LAST-REMOTE-UPDATE-IDATE)) + (IGREATERP (IDIFFERENCE (IDATE) + LAST-REMOTE-UPDATE-IDATE) + (CONSTANT (TIMES 24 60 60 1000] + (PRINTOUT T "Updating from remote, local branch is " (GIT-WHICH-BRANCH PROJECT) + T) + (PROG1 (GIT-COMMAND "git remote update origin" NIL PROJECT) + (SETQ LAST-REMOTE-UPDATE-IDATE (IDATE))))]) + +(GIT-REMOTE-ADD + [LAMBDA (NAME URL) (* ; "Edited 31-Jan-2022 13:53 by rmk") + (LET [(RESULT (GIT-COMMAND (CONCAT "git remote add " NAME " " URL] + + (* ;; "Does it return an error line? What if URL is not good? ") + + (CAR RESULT]) + +(GIT-FILE-DATE + [LAMBDA (GFILE BRANCH PROJECT) (* ; "Edited 8-May-2022 16:56 by rmk") + (* ; "Edited 6-Mar-2022 17:41 by rmk") + (* ; "Edited 3-Jan-2022 19:43 by rmk") + (CL:WHEN (AND NIL BRANCH (STRPOS "local/" BRANCH 1 NIL T)) + (SETQ BRANCH (SUBSTRING BRANCH 7))) + (LET [(DATE (CAR (GIT-COMMAND (CONCAT "git log -1 --pretty=%"format:%%cD%" " + (CL:IF BRANCH + (CONCAT BRANCH " -- ") + "") + (GIT-REPO-FILENAME GFILE PROJECT)) + NIL T PROJECT] + DATE]) +) + + + +(* ;; "Differences") + +(DEFINEQ (GIT-BRANCH-DIFF - [LAMBDA (BRANCH1 BRANCH2) + [LAMBDA (BRANCH1 BRANCH2 PROJECT) - (* ;; "Edited 29-Apr-2022 07:17 by rmk: returns an ALIST that classifies how the files in BRANCH1 and BRANCH2 differ (changed, renamed, added, deleted, copied).") + (* ;; "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).") + + (* ;; "Edited 6-May-2022 14:04 by rmk: returns an ALIST that classifies how the files in BRANCH1 and BRANCH2 differ (changed, renamed, added, deleted, copied).") (* ;; "This returns an ALIST that classifies how the files in BRANCH1 and BRANCH2 differ (changed, renamed, added, deleted, copied).") (CL:UNLESS BRANCH1 - (SETQ BRANCH1 'origin/master)) + (SETQ BRANCH1 (GIT-MAINBRANCH PROJECT))) (CL:UNLESS BRANCH2 - (SETQ BRANCH2 'origin/master)) - (GIT-REMOTE-UPDATE) - (LET ([MERGE (CAR (GIT-COMMAND (CONCAT "git merge-base " BRANCH1 " " BRANCH2] - LINES POS) - (CL:WHEN (STRPOS "fatal" MERGE) - (ERROR (CONCAT "merge-base failed for " (LIST BRANCH1 BRANCH2)))) - (SETQ LINES (GIT-COMMAND (CONCAT "git diff --name-status -C --find-copies-harder " MERGE " " - BRANCH1))) + (SETQ BRANCH2 (GIT-MAINBRANCH PROJECT))) + (GIT-REMOTE-UPDATE NIL PROJECT) (* (* ;; "Returns the status (M, R, D, A, C), but not sure what comparison is used for the letters. With --name-only, you just get the list of files in the commit. (GIT-COMMIT-DIFFS gives the commits that differ between 2 branches. But what if a given file shows up in 2 different commits in a sequence? E.g. it was changed and then deleted? For each files we can calculate the sequence of changes and figure out what the net effect is? e.g (file D (R file2) (C file3) A) would say that that file didn't exist at the beginning and doesn't exist at the end, so don't report it?") + (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) @@ -530,105 +900,75 @@ (HELP "Unrecognized git-diff code" (NTHCHAR L 1] T]) -(GIT-APPROVAL - [LAMBDA (BRANCH) (* ; "Edited 19-Nov-2021 15:08 by rmk:") - (GIT-ADD-WORKTREE BRANCH T) - (GIT-ADD-WORKTREE "master" T]) +(GIT-COMMIT-DIFFS + [LAMBDA (BRANCH1 BUTNOTBRANCH2 PROJECT) (* ; "Edited 7-May-2022 23:48 by rmk") + (* ; "Edited 2-May-2022 13:45 by rmk") -(GIT-GET-FILE - [LAMBDA (BRANCH GITFILE LOCALFILE NOERROR) + (* ;; "Returns the identifiers for commits in BRANCH1 but not in BUTNOTBRANCH2") - (* ;; "Edited 6-Mar-2022 17:45 by rmk: the stream, not the name because of the NODIRCORE case.") + (GIT-COMMAND (CONCAT "git log --format=%"%%h%" " BRANCH1 " ^" BUTNOTBRANCH2) + NIL NIL PROJECT]) - (* ;; "Returns the stream, not the name because of the NODIRCORE case.") +(GIT-BRANCH-RELATIONS + [LAMBDA (BRANCHES BRANCH2 STRIPWHERE PROJECT) (* ; "Edited 9-May-2022 16:12 by rmk") - (* ;; "If GITFILE in (remote) BRANCH exists, it is copied to LOCALFILE and LOCALFILE is returned. If it doesn't exist, return value is NIL if NOERROR, otherwise an ERROR.") + (* ;; "Returns a pair (SUPERSETS EQUALS), where each item in SUPERSETS is a list of the form (B0 B1 B2...) where each Bi is a superset of Bj for i < j and EQUALS is a list of branch equivalence classes. ") - (CL:WHEN (AND BRANCH (STRPOS "local/" BRANCH 1 NIL T)) - (SETQ BRANCH (SUBSTRING BRANCH 7))) - (CL:WITH-OPEN-STREAM (s (CREATE-PROCESS-STREAM (CONCAT (CDGITDIR) - "git show " BRANCH ":" GITFILE))) - (SETFILEINFO s 'ENDOFSTREAMOP (FUNCTION NILL)) - (LET (BYTES) - (IF (FOR I B C FROM 1 WHILE (SETQ C (NTHCHARCODE "fatal: " I)) - DO - (* ;; - "Returns NIL if we run off the fatal string with a match, otherwise T") + (CL:WHEN BRANCH2 + (SETQ BRANCHES (LIST BRANCHES BRANCH2))) + (FOR DTAIL D1 MORE1 MORE2 SUPERSETS EQUALS ON (FOR B IN BRANCHES + COLLECT (CONS B (GIT-COMMIT-DIFFS B ( + GIT-MAINBRANCH + PROJECT) + PROJECT))) + DO + (* ;; "For each branch we now have the list of commit identifiers (hexstrings) that they do not share with the main branch.") - (CL:UNLESS (SETQ B (\BIN s)) - (RETURN T)) - (PUSH BYTES B) - (CL:UNLESS (EQ B C) - (RETURN T))) - THEN - (* ;; "Don't open STREAM until we know the file is real") + (SETQ D1 (CAR DTAIL)) + [FOR D2 IN (CDR DTAIL) + DO (CL:WHEN (EQUAL (CDR D1) + (CDR D2)) (* ; "Unlikely") + (PUSH [CDR (OR (ASSOC (CAR D1) + EQUALS) + (CAR (PUSH EQUALS (CONS (CAR D1] + (CAR D2)) + (GO $$ITERATE)) + (SETQ MORE2 (MEMBER (CADR D1) + (CDR D2))) (* ; + "The most recent commit of D1 is in D2") + (SETQ MORE1 (MEMBER (CADR D2) + (CDR D1))) + (IF MORE2 + THEN (CL:UNLESS MORE1 + (PUSH [CDR (OR (ASSOC (CAR D2) + SUPERSETS) + (CAR (PUSH SUPERSETS (CONS (CAR D2] + (CAR D1))) + ELSEIF MORE1 + THEN (PUSH [CDR (OR (ASSOC (CAR D1) + SUPERSETS) + (CAR (PUSH SUPERSETS (CONS (CAR D1] + (CAR D2] + FINALLY - (CL:WITH-OPEN-FILE (STREAM (OR LOCALFILE '{NODIRCORE) - :IF-EXISTS :NEW-VERSION :DIRECTION :IO) - (FOR B IN (DREVERSE BYTES) DO (\BOUT STREAM B)) - [DO (\BOUT STREAM (OR (\BIN s) - (RETURN] - (SETFILEINFO STREAM 'CREATIONDATE (OR (FILEDATE STREAM T) - (FILEDATE STREAM) - (GIT-FILE-DATE GITFILE BRANCH)) - ) - STREAM) - ELSEIF NOERROR - THEN NIL - ELSE (ERROR "GIT FILE NOT FOUND" GITFILE]) + (* ;; "Sort the supersets so that the larger ones come before the smaller ones") -(GIT-FILE-EXISTS? - [LAMBDA (BRANCH GITFILE) (* ; "Edited 6-Mar-2022 19:04 by rmk") - (* ; "Edited 10-Feb-2022 20:55 by rmk") - (* ; "Edited 10-Dec-2021 21:30 by rmk") - - (* ;; "T if GITFILE exists on BRANCH. If s is EOFP, the file exists but is empty") - - (CL:WITH-OPEN-STREAM (s (CREATE-PROCESS-STREAM (CONCAT (CDGITDIR) - "git show " BRANCH ":" GITFILE))) - (SETFILEINFO s 'ENDOFSTREAMOP (FUNCTION NILL)) - (NOT (FOR I C FROM 1 WHILE (SETQ C (NTHCHARCODE "fatal: " I)) - ALWAYS (EQ (BIN s) - C]) - -(GIT-REMOTE-UPDATE - [LAMBDA (DOIT) (* ; "Edited 16-Dec-2021 10:45 by rmk") - (* ; "Edited 4-Dec-2021 21:49 by rmk") - (* ; "Edited 2-Dec-2021 08:44 by rmk:") - (* ; "Edited 24-Nov-2021 16:34 by rmk:") - (DECLARE (USEDFREE LAST-REMOTE-UPDATE-IDATE)) - - (* ;; "Because git hangs on this (and other things), do this no more than once a day") - - (CL:WHEN [OR DOIT (NOT (BOUNDP 'LAST-REMOTE-UPDATE-IDATE)) - (IGREATERP (IDIFFERENCE (IDATE) - LAST-REMOTE-UPDATE-IDATE) - (CONSTANT (TIMES 24 60 60 1000] - (PRINTOUT T "Updating from remote, local branch is " (GIT-WHICH-BRANCH) - T) - (PROG1 (GIT-COMMAND "git remote update origin") - (SETQ LAST-REMOTE-UPDATE-IDATE (IDATE))))]) - -(GIT-REMOTE-ADD - [LAMBDA (NAME URL) (* ; "Edited 31-Jan-2022 13:53 by rmk") - (LET [(RESULT (GIT-COMMAND (CONCAT "git remote add " NAME " " URL] - - (* ;; "Does it return an error line? What if URL is not good? ") - - (CAR RESULT]) - -(GIT-FILE-DATE - [LAMBDA (GFILE BRANCH) (* ; "Edited 6-Mar-2022 17:41 by rmk") - (* ; "Edited 3-Jan-2022 19:43 by rmk") - (CL:WHEN (AND NIL BRANCH (STRPOS "local/" BRANCH 1 NIL T)) - (SETQ BRANCH (SUBSTRING BRANCH 7))) - (LET [(DATE (CAR (GIT-COMMAND (CONCAT "git log -1 --pretty=%"format:%%cD%" " - (CL:IF BRANCH - (CONCAT BRANCH " -- ") - "") - (GIT-REPO-FILENAME GFILE T)) - NIL T] - DATE]) + (CL:WHEN STRIPWHERE + [SETQ SUPERSETS (FOR S IN SUPERSETS COLLECT (FOR SS IN S COLLECT (STRIPWHERE SS] + [SETQ EQUALS (FOR S IN EQUALS COLLECT (FOR SS IN S COLLECT (STRIPWHERE SS]) + [FOR S IN SUPERSETS + DO (CHANGE (CDR S) + (SORT DATUM (FUNCTION (LAMBDA (B1 B2) + (OR (MEMB B2 (CDR (ASSOC B1 SUPERSETS))) + (NOT (MEMB B1 (CDR (ASSOC B2 SUPERSETS] + [FOR E IN EQUALS DO (CHANGE (CDR E) + (IF (MEMB (GIT-MAINBRANCH PROJECT) + (CDR E)) + THEN (CONS (GIT-MAINBRANCH PROJECT) + (DREMOVE (GIT-MAINBRANCH PROJECT) + (SORT DATUM))) + ELSE (SORT DATUM] + (RETURN (LIST SUPERSETS EQUALS]) ) @@ -643,27 +983,24 @@ (DEFINEQ (GIT-CHECKOUT - [LAMBDA (BRANCH) (* ; "Edited 2-Nov-2021 22:40 by rmk:") - (CAR (GIT-COMMAND (CONCAT "git checkout " (OR BRANCH "master") - "; git pull"]) + [LAMBDA (BRANCH PROJECT) (* ; "Edited 9-May-2022 15:12 by rmk") + (* ; "Edited 7-May-2022 23:51 by rmk") + (* ; "Edited 2-Nov-2021 22:40 by rmk:") + (CAR (GIT-COMMAND (CONCAT "git checkout " (OR BRANCH (GIT-MAINBRANCH PROJECT)) + "; git pull") + NIL NIL PROJECT]) (GIT-WHICH-BRANCH - [LAMBDA NIL (* ; "Edited 14-Dec-2021 23:39 by rmk") - (* ; "Edited 12-Dec-2021 11:56 by rmk") - (* ; "Edited 6-Nov-2021 12:11 by rmk:") - (* ; "Edited 3-Oct-2021 15:32 by rmk:") + [LAMBDA (PROJECT) (* ; "Edited 7-May-2022 22:41 by rmk") - (* ;; "Returns the current (local) branch") + (* ;; "Returns the current (local) branch in PROJECT") - (MKATOM (CONCAT "local/" (CAR (GIT-COMMAND "git rev-parse --abbrev-ref HEAD"]) + (MKATOM (CONCAT "local/" (CAR (GIT-COMMAND "git rev-parse --abbrev-ref HEAD" NIL NIL PROJECT]) (GIT-MAKE-BRANCH - [LAMBDA (NAME TITLESTRING) (* ; "Edited 26-Jan-2022 12:12 by rmk") - (* ; "Edited 19-Jan-2022 23:25 by rmk") - (* ; "Edited 8-Jan-2022 09:48 by rmk") - (* ; "Edited 2-Nov-2021 21:28 by rmk:") + [LAMBDA (NAME TITLESTRING PROJECT) (* ; "Edited 9-May-2022 15:13 by rmk") - (* ;; " The new branch is directly under the currently checked out branch. Maybe it should always make it under master?") + (* ;; " The new branch is directly under the currently checked out branch. Maybe it should always make it under the main branch?") (* ;;  "This makes a new branch with name NAME: TITLESTRING, or just NAME if TITLESTRING is not given.") @@ -671,11 +1008,12 @@ (* ;; "(GIT-MAKE-BRANCH) makes and checks out the next initialsn branch.") (CL:UNLESS NAME - (SETQ NAME (GIT-MY-NEXT-BRANCH))) + (SETQ NAME (GIT-MY-NEXT-BRANCH PROJECT))) (CL:WHEN TITLESTRING (SETQ NAME (CONCAT NAME (CONCAT ": " TITLESTRING)))) - (LET [(UNDER (GIT-WHICH-BRANCH)) - (RESULT (GIT-COMMAND (CONCAT "git checkout -b " NAME] + (LET ((UNDER (GIT-WHICH-BRANCH PROJECT)) + (RESULT (GIT-COMMAND (CONCAT "git checkout -b " NAME) + NIL NIL PROJECT))) (IF (STREQUAL (CAR RESULT) (CONCAT "Switched to a new branch '" NAME "'")) THEN (CONCAT (CAR RESULT) @@ -686,73 +1024,85 @@ ELSE (HELP "Unexpected git result" RESULT]) (GIT-BRANCHES - [LAMBDA (WHERE) (* ; "Edited 6-Mar-2022 08:54 by rmk") - (* ; "Edited 24-Feb-2022 21:20 by rmk") - (* ; "Edited 8-Dec-2021 08:43 by rmk") - (* ; "Edited 17-Nov-2021 18:20 by rmk:") - (* ; "Edited 16-Nov-2021 09:21 by rmk:") + [LAMBDA (WHERE PROJECT) (* ; "Edited 9-May-2022 14:10 by rmk") + (* ; "Edited 7-May-2022 23:29 by rmk") + (SETQ PROJECT (GIT-GET-PROJECT PROJECT)) (* ;; "Strips of the %"* %" that indicates the current branch and the 2-space padding on other branches. Packs local/ on to local branches") (LET [[LOCAL (CL:WHEN (MEMB (U-CASE WHERE) '(NIL ALL LOCAL)) - (FOR B IN (GIT-COMMAND "git branch") COLLECT (PACK* "local/" (SUBATOM B 3))))] + (FOR B IN (GIT-COMMAND "git branch" NIL NIL PROJECT) + COLLECT (PACK* "local/" (SUBATOM B 3))))] (REMOTE (CL:WHEN (MEMB (U-CASE WHERE) '(NIL ALL REMOTE T)) - (FOR B IN (GIT-COMMAND "git branch -r") COLLECT (SUBATOM B 3)))] + (FOR B IN (GIT-COMMAND "git branch -r" NIL NIL PROJECT) + COLLECT (SUBATOM B 3)))] (SORT (APPEND LOCAL REMOTE]) (GIT-BRANCH-EXISTS? - [LAMBDA (BRANCH WHERE NOERROR) (* ; "Edited 6-Mar-2022 15:28 by rmk") - (* ; "Edited 16-Dec-2021 08:50 by rmk") - (* ; "Edited 8-Dec-2021 08:44 by rmk") - (* ; "Edited 19-Nov-2021 15:13 by rmk:") + [LAMBDA (BRANCH NOERROR PROJECT) (* ; "Edited 9-May-2022 14:18 by rmk") + (* ; "Edited 7-May-2022 23:28 by rmk") + (* ; "Edited 3-May-2022 12:56 by rmk") (* ; "Edited 17-Nov-2021 18:24 by rmk:") (* ;; "Returns the canonical name of the branch (xxx or origin/xxx) depending on whether BRANCH is local/xxx or origin/xxx") - (* ; "Edited 16-Nov-2021 09:25 by rmk:") - (IF [CAR (MEMB (MKATOM BRANCH) + + (IF (CAR (MEMB (MKATOM BRANCH) (GIT-BRANCHES (IF (STRPOS "origin/" BRANCH 1 NIL T) THEN 'REMOTE ELSEIF (STRPOS "local/" BRANCH 1 NIL T) - THEN 'LOCAL] + THEN 'LOCAL) + PROJECT))) ELSEIF (NOT NOERROR) THEN (ERROR "Unknown branch" BRANCH]) (GIT-PICK-BRANCH - [LAMBDA (BRANCHES TITLE WHERE) (* ; "Edited 6-Mar-2022 08:55 by rmk") + [LAMBDA (BRANCHES TITLE WHERE PROJECT) (* ; "Edited 11-May-2022 23:53 by rmk") + (* ; "Edited 9-May-2022 17:07 by rmk") + (* ; "Edited 7-May-2022 23:54 by rmk") + (* ; "Edited 6-Mar-2022 08:55 by rmk") (* ; "Edited 25-Feb-2022 09:02 by rmk") (MENU (CREATE MENU TITLE _ (OR TITLE 'Branches) ITEMS _ (OR (LISTP BRANCHES) - (GIT-BRANCHES WHERE)) + (GIT-BRANCHES WHERE PROJECT)) MENUFONT _ DEFAULTFONT]) (GIT-PRC-MENU - [LAMBDA (DRAFT) (* ; "Edited 29-Apr-2022 11:36 by rmk") - (LET* [(PRS (GIT-PULL-REQUESTS T DRAFT)) - (SUPERSETS (CAR (GIT-BRANCH-RELATIONS (FOR PR IN PRS COLLECT (CADDR PR] - - (* ;; "Reverse on the theory that rmknnn's should be ordered from nnn highest to lowest") - - (DREVERSE (SORT [FOR PR SUP LABEL IN PRS - COLLECT (SETQ LABEL (CL:IF [SETQ SUP (CAR (CDR (ASSOC (CADDR PR) - SUPERSETS] - (CONCAT (CADDR PR) - " > " SUP) - (CADDR PR))) - (LIST (CL:IF (MEMB 'DRAFT PR) - (CONCAT LABEL " (draft)") - LABEL) - (GITORIGIN (CADDR PR)) - (CONCAT " " (CADR PR) - " #" - (CAR PR] - T]) + [LAMBDA (DRAFT PROJECT) (* ; "Edited 9-May-2022 16:54 by rmk") + (* ; "Edited 7-May-2022 23:48 by rmk") + (* ; "Edited 6-May-2022 09:59 by rmk") + (* ; "Edited 3-May-2022 22:58 by rmk") + (* ; "Edited 29-Apr-2022 21:42 by rmk") + (LET* ((PRS (GIT-PULL-REQUESTS T DRAFT PROJECT)) + (RELATIONS (GIT-BRANCH-RELATIONS (FOR PR IN PRS COLLECT (GITORIGIN (CADDR PR))) + NIL T PROJECT)) + (SUPERSETS (CAR RELATIONS)) + (EQUALS (CADR RELATIONS))) + (SORT [FOR PR REL LABEL IN PRS + COLLECT (SETQ LABEL (IF [SETQ REL (CAR (CDR (SASSOC (CADDR PR) + SUPERSETS] + THEN (CONCAT (CADDR PR) + " > " REL) + ELSEIF [SETQ REL (CAR (CDR (SASSOC (CADDR PR) + EQUALS] + THEN (CONCAT (CADDR PR) + " = " REL) + ELSE (CADDR PR))) + (LIST (CL:IF (MEMB 'DRAFT PR) + (CONCAT LABEL " (draft)") + LABEL) + (GITORIGIN (CADDR PR)) + (CONCAT " " (CADR PR) + " #" + (CAR PR] + T]) (GIT-PULL-REQUESTS - [LAMBDA (ALLINFO INCLUDEDRAFTS) (* ; "Edited 25-Feb-2022 09:26 by rmk") - (FOR LINE TAB1 TAB2 TAB3 VAL IN (GIT-COMMAND "gh pr list" T) + [LAMBDA (ALLINFO INCLUDEDRAFTS PROJECT) (* ; "Edited 9-May-2022 16:54 by rmk") + (* ; "Edited 25-Feb-2022 09:26 by rmk") + (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))) (SETQ TAB3 (STRPOS " " LINE (ADD1 TAB2))) @@ -766,53 +1116,6 @@ ,(SUBATOM LINE (ADD1 TAB3] ELSE (SUBATOM LINE (ADD1 TAB2) (SUB1 TAB3]) - -(GIT-BRANCH-RELATIONS - [LAMBDA (BRANCHES BRANCH2) (* ; "Edited 29-Apr-2022 11:05 by rmk") - - (* ;; "Returns a pair (SUPERSETS EQUALS), where each item in SUPERSETS is a list of the form (B0 B1 B2...) where each Bi is a superset of Bj for i < j and EQUALS is a list of branch equivalence classes. ") - - (CL:WHEN BRANCH2 - (SETQ BRANCHES (LIST BRANCHES BRANCH2))) - (FOR DTAIL D1 MORE1 MORE2 SUPERSETS EQUALS ON [FOR B IN BRANCHES - COLLECT (CONS B (GIT-BRANCH-DIFF (GITORIGIN - B) - 'origin/master] - DO (SETQ D1 (CAR DTAIL)) - [FOR D2 IN (CDR DTAIL) - DO (SETQ MORE1 (CL:SET-DIFFERENCE (CDR D1) - (CDR D2) - :TEST - (FUNCTION EQUAL))) - (SETQ MORE2 (CL:SET-DIFFERENCE (CDR D2) - (CDR D1) - :TEST - (FUNCTION EQUAL))) - (IF MORE2 - THEN (CL:UNLESS MORE1 - (PUSH [CDR (OR (ASSOC (CAR D2) - SUPERSETS) - (CAR (PUSH SUPERSETS (CONS (CAR D2] - (CAR D1))) - ELSEIF MORE1 - THEN (PUSH [CDR (OR (ASSOC (CAR D1) - SUPERSETS) - (CAR (PUSH SUPERSETS (CONS (CAR D1] - (CAR D2)) - ELSE (PUSH [CDR (OR (ASSOC (CAR D1) - EQUALS) - (CAR (PUSH EQUALS (CONS (CAR D1] - (CAR D2] - FINALLY - - (* ;; "Sort the supersets so that the larger ones come before the smaller ones") - - [FOR S IN SUPERSETS - DO (CHANGE (CDR S) - (SORT DATUM (FUNCTION (LAMBDA (B1 B2) - (OR (MEMB B2 (CDR (ASSOC B1 SUPERSETS))) - (NOT (MEMB B1 (CDR (ASSOC B2 SUPERSETS] - (RETURN (LIST SUPERSETS EQUALS]) ) @@ -822,17 +1125,19 @@ (DEFINEQ (GIT-MY-CURRENT-BRANCH - [LAMBDA NIL (* ; "Edited 19-Jan-2022 13:22 by rmk") - (CAR (LAST (GIT-MY-BRANCHES]) + [LAMBDA (PROJECT) (* ; "Edited 7-May-2022 23:51 by rmk") + (* ; "Edited 19-Jan-2022 13:22 by rmk") + (CAR (LAST (GIT-MY-BRANCHES PROJECT]) (GIT-MY-BRANCHP - [LAMBDA (BRANCH) (* ; "Edited 26-Jan-2022 11:41 by rmk") + [LAMBDA (BRANCH PROJECT) (* ; "Edited 7-May-2022 23:56 by rmk") + (* ; "Edited 26-Jan-2022 11:41 by rmk") (* ; "Edited 19-Jan-2022 13:22 by rmk") (* ;; "Returns n if BRANCH is INITIALSn (local or origin), possibly followed by a trailing comment after colon or space.") (CL:UNLESS BRANCH - (SETQ BRANCH (GIT-WHICH-BRANCH))) + (SETQ BRANCH (GIT-WHICH-BRANCH PROJECT))) (LET* ((INITS (GIT-INITIALS)) (INC (NCHARS INITS)) (SPOS (ADD1 (OR (STRPOS "/" BRANCH) @@ -846,17 +1151,20 @@ EPOS))]) (GIT-MY-NEXT-BRANCH - [LAMBDA NIL (* ; "Edited 19-Jan-2022 23:14 by rmk") + [LAMBDA (PROJECT) (* ; "Edited 7-May-2022 23:56 by rmk") + (* ; "Edited 19-Jan-2022 23:14 by rmk") (* ; "Edited 8-Jan-2022 09:43 by rmk") (* ;; "Figures out what my next incremental branch would be. ") (PACK* (GIT-INITIALS) - (ADD1 (OR (GIT-MY-BRANCHP (GIT-MY-CURRENT-BRANCH)) + (ADD1 (OR (GIT-MY-BRANCHP (GIT-MY-CURRENT-BRANCH PROJECT) + PROJECT) 0]) (GIT-MY-BRANCHES - [LAMBDA NIL (* ; "Edited 6-Mar-2022 21:50 by rmk") + [LAMBDA (PROJECT) (* ; "Edited 7-May-2022 23:51 by rmk") + (* ; "Edited 6-Mar-2022 21:50 by rmk") (* ; "Edited 19-Jan-2022 13:20 by rmk") (* ; "Edited 8-Jan-2022 09:53 by rmk") (* ; "Edited 12-Dec-2021 11:46 by rmk") @@ -868,7 +1176,7 @@ (* ;; "The return list is sorted so that lower n's come before later n's. The last element is my current branch") (FOR B (INITS _ (CONCAT "local/" (GIT-INITIALS))) - INC IN (GIT-BRANCHES) FIRST (SETQ INC (NCHARS INITS)) + INC IN (GIT-BRANCHES NIL PROJECT) FIRST (SETQ INC (NCHARS INITS)) WHEN (STRPOS INITS B 1 NIL T NIL UPPERCASEARRAY) COLLECT B FINALLY (RETURN (SORT $$VAL (FUNCTION (LAMBDA (A B) (ILESSP (SUBATOM A (ADD1 INC)) @@ -887,43 +1195,43 @@ (DEFINEQ (GIT-ADD-WORKTREE - [LAMBDA (BRANCH REMOTEONLY) (* ; "Edited 6-Mar-2022 15:51 by rmk") - (* ; "Edited 12-Dec-2021 11:57 by rmk") - (* ; "Edited 25-Nov-2021 08:45 by rmk:") - (* ; "Edited 19-Nov-2021 19:01 by rmk:") - (* ; "Edited 17-Nov-2021 18:25 by rmk:") + [LAMBDA (BRANCH REMOTEONLY PROJECT) (* ; "Edited 9-May-2022 14:17 by rmk") (SETQ BRANCH (GITORIGIN BRANCH (NOT REMOTEONLY))) - (CL:UNLESS (OR (GIT-BRANCH-EXISTS? BRANCH NIL T) - (GIT-BRANCH-EXISTS? BRANCH T)) + (CL:UNLESS (OR (GIT-BRANCH-EXISTS? BRANCH T PROJECT) + (GIT-BRANCH-EXISTS? BRANCH T PROJECT)) (ERROR BRANCH "is not a git branch")) - (CL:WHEN (STRING-EQUAL BRANCH (GIT-WHICH-BRANCH)) + (CL:WHEN (STRING-EQUAL BRANCH (GIT-WHICH-BRANCH PROJECT)) (ERROR BRANCH "is the current branch")) (LET (LINES LOCALBRANCH) - [SETQ LINES (GIT-COMMAND (IF (EQ 1 (STRPOS "origin/" BRANCH)) + (SETQ LINES (GIT-COMMAND (IF (EQ 1 (STRPOS "origin/" BRANCH)) THEN [SETQ LOCALBRANCH (SUBSTRING BRANCH (CONSTANT (ADD1 (NCHARS "origin/" ] - (CONCAT "git worktree add --guess-remote " (WORKTREEDIR - LOCALBRANCH) + (CONCAT "git worktree add --guess-remote " + (WORKTREEDIR LOCALBRANCH PROJECT) " " BRANCH) ELSE (CONCAT "git worktree add " (WORKTREEDIR BRANCH) - " " BRANCH] + " " BRANCH)) + NIL NIL PROJECT)) (CL:UNLESS (STRPOS "Preparing worktree" (CAR LINES) 1 NIL T) (ERROR "Could not create worktree for " BRANCH)) BRANCH]) (GIT-REMOVE-WORKTREE - [LAMBDA (BRANCH) (* ; "Edited 17-Nov-2021 10:02 by rmk:") - (GIT-BRANCH-EXISTS? BRANCH) - (LET ((DIR (WORKTREEDIR BRANCH)) + [LAMBDA (BRANCH PROJECT) (* ; "Edited 9-May-2022 16:22 by rmk") + (* ; "Edited 17-Nov-2021 10:02 by rmk:") + (GIT-BRANCH-EXISTS? BRANCH NIL PROJECT) + (LET ((DIR (WORKTREEDIR BRANCH PROJECT)) LINES) - (SETQ LINES (GIT-COMMAND (CONCAT "git worktree remove " DIR))) + (SETQ LINES (GIT-COMMAND (CONCAT "git worktree remove " DIR) + NIL NIL PROJECT)) (CL:WHEN (STRPOS "fatal: " (CAR LINES) 1 NIL T) (ERROR "Could not remove worktree for " BRANCH)) - (AND NIL (DELFILE (CONCAT PATH "/.DS_Store")) - (GIT-COMMAND (CONCAT "rmdir " DIR))) + (* (DELFILE (CONCAT PATH "/.DS_Store")) + (GIT-COMMAND (CONCAT "rmdir " DIR) NIL + NIL PROJECT)) BRANCH]) (GIT-LIST-WORKTREES @@ -938,13 +1246,16 @@ (SUBATOM L 1 (SUB1 (STRPOS " " L]) (WORKTREEDIR - [LAMBDA (BRANCH) (* ; "Edited 18-Jan-2022 15:02 by rmk") - (* ; "Edited 25-Nov-2021 08:49 by rmk:") - (* ; "Edited 19-Nov-2021 20:56 by rmk:") - (* ; "Edited 17-Nov-2021 10:00 by rmk:") - (CONCAT GITMEDLEYDIR "../worktrees/" (IF BRANCH - THEN "/" - ELSE ""]) + [LAMBDA (BRANCH PROJECT) (* ; "Edited 9-May-2022 00:04 by rmk") + (* ; "Edited 18-Jan-2022 15:02 by rmk") + (* ; "Edited 25-Nov-2021 08:49 by rmk:") + (* ; "Edited 19-Nov-2021 20:56 by rmk:") + (* ; "Edited 17-Nov-2021 10:00 by rmk:") + (CONCAT (FETCH GITHOST OF PROJECT) + "../worktrees/" + (IF BRANCH + THEN "/" + ELSE ""]) ) @@ -959,28 +1270,23 @@ (DEFINEQ (GIT-GET-DIFFERENT-FILES - [LAMBDA (BRANCH1 BRANCH2 DIR1 DIR2) (* ; "Edited 29-Apr-2022 07:53 by rmk") - (* ; "Edited 5-Jan-2022 08:01 by rmk") + [LAMBDA (BRANCH1 BRANCH2 DIR1 DIR2 PROJECT) (DECLARE (USEDFREE FROMGITN)) - (* ;; "Ask git for the files that differ between the branches, copy those files down to local DIR1 and DIR2, return the directories and a list of (dir1-file1 file2) mappings for renamed and copied files.") + (* ;; "Edited 9-May-2022 14:17 by rmk: Ask git for the files that differ between the branches, copy those files down to local DIR1 and DIR2, return the directories and a list of (dir1-file1 file2) mappings for renamed and copied files.") - (SETQ BRANCH1 (GIT-BRANCH-EXISTS? BRANCH1)) - (SETQ BRANCH2 (GIT-BRANCH-EXISTS? BRANCH2)) + (* ;; "Edited 6-May-2022 08:26 by rmk: Ask git for the files that differ between the branches, copy those files down to local DIR1 and DIR2, return the directories and a list of (dir1-file1 file2) mappings for renamed and copied files.") + + (SETQ BRANCH1 (GIT-BRANCH-EXISTS? BRANCH1 NIL PROJECT)) + (SETQ BRANCH2 (GIT-BRANCH-EXISTS? BRANCH2 NIL PROJECT)) (LET - ([MERGE (CAR (GIT-COMMAND (CONCAT "git merge-base " BRANCH1 " " BRANCH2] - DIFFS MAPPINGS FROMGIT) - - (* ;; "Collapse them together for now") - - (SETQ DIFFS (GIT-BRANCH-DIFF BRANCH1 MERGE)) - - (* ;; "DIFFS is an alist with keys ADDED, DELETED, CHANGED, MOVED") - + (MAPPINGS FROMGIT (DIFFS (GIT-BRANCH-DIFF BRANCH1 BRANCH2 PROJECT))) (CL:WHEN DIFFS (SETQ FROMGIT (PACK* '{FROMGIT (ADD FROMGITN 1) '})) - (PSEUDOHOST FROMGIT (CONCAT "{CORE}" (DATE) + (PSEUDOHOST FROMGIT (CONCAT "{CORE}<" (FETCH PROJECTNAME OF PROJECT) + ">" + (DATE) ">")) (* ;; "UNSLASHIT because CORE doesn't know about slash") @@ -994,23 +1300,29 @@ (FOR D IN DIFFS DO (SELECTQ (CAR D) (ADDED (* ; - "Shouldn't exist in MERGE, should exist in BRANCH1") - (GIT-GET-FILE BRANCH1 GFILE (CONCAT DIR1 (CADR D)))) + "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 MERGE. 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.") + (* ;; "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 MERGE D (CONCAT DIR2 D) - T) + (OR (GIT-GET-FILE BRANCH2 D (CONCAT DIR2 D) + T PROJECT) (GIT-GET-FILE BRANCH1 D (CONCAT DIR1 D) - T))) + T PROJECT))) (CHANGED (* ; "Should exist in both branches") (SETQ D (CADR D)) - (GIT-GET-FILE BRANCH1 D (CONCAT DIR1 D)) - (GIT-GET-FILE MERGE D (CONCAT DIR2 D))) + (GIT-GET-FILE BRANCH1 D (CONCAT DIR1 D) + T PROJECT) + (GIT-GET-FILE BRANCH2 D (CONCAT DIR2 D) + T PROJECT)) ((RENAMED COPIED) - (* ;; "These entries are from-to filename pairs. If (CADDR) is 100, only need to fetch one, because it presumably has disappeared in MERGE and reappeared in BRANCH1. MAPPINGS is returned so the connection can be reestablished higher up. ") + (* ;; "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.") @@ -1024,8 +1336,9 @@ (* ;; "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] + (SETQ F1 (GIT-GET-FILE BRANCH1 (CADR GFILE) + (CONCAT DIR1 (CADR GFILE)) + T PROJECT)) (IF (EQ (CADDR GFILE) 100) THEN @@ -1043,28 +1356,27 @@ (* ;;  "If not a perfect match, then the directory should figure it out") - (GIT-GET-FILE MERGE (CAR GFILE) + (GIT-GET-FILE BRANCH2 (CAR GFILE) (CONCAT DIR2 (CAR GFILE)) - T)))) - (HELP "UNKNOWN GIT-DIFF TAG" DLIST))) + T PROJECT)))) + (HELP "UNKNOWN GIT-DIFF TAG" D))) (LIST DIR1 DIR2 MAPPINGS))]) (GIT-COMPARE-BRANCHES - [LAMBDA (BRANCH1 BRANCH2 LOCAL) (* ; "Edited 6-Mar-2022 19:52 by rmk") - (* ; "Edited 22-Feb-2022 22:53 by rmk") - (* ; "Edited 19-Feb-2022 10:21 by rmk") - (* ; "Edited 13-Feb-2022 21:27 by rmk") - (* ; "Edited 2-Feb-2022 08:46 by rmk") - (* ; "Edited 28-Jan-2022 23:58 by rmk") + [LAMBDA (BRANCH1 BRANCH2 LOCAL PROJECT) (* ; "Edited 9-May-2022 15:14 by rmk") + (* ; "Edited 3-May-2022 23:04 by rmk") + (SETQ PROJECT (GIT-GET-PROJECT PROJECT)) (SETQ BRANCH1 (IF BRANCH1 THEN (GITORIGIN BRANCH1 LOCAL) - ELSE (GIT-WHICH-BRANCH))) - (SETQ BRANCH2 (GITORIGIN (OR BRANCH2 "master") + ELSE (GIT-WHICH-BRANCH PROJECT))) + (SETQ BRANCH2 (GITORIGIN (OR BRANCH2 (GIT-MAINBRANCH PROJECT)) LOCAL)) - (PRINTOUT T "Comparing all subdirectories of " BRANCH1 " and " BRANCH2 T) + (PRINTOUT T "Comparing all " (L-CASE (FETCH PROJECTNAME OF PROJECT) + T) + " subdirectories of " BRANCH1 " and " BRANCH2 T) (LET (CDVALUE DIRS NENTRIES MAPPINGS) (PRINTOUT T "Fetching differences" T) - (SETQ DIRS (GIT-GET-DIFFERENT-FILES BRANCH1 BRANCH2)) + (SETQ DIRS (GIT-GET-DIFFERENT-FILES BRANCH1 BRANCH2 NIL NIL PROJECT)) (SETQ MAPPINGS (CADDR DIRS)) (IF DIRS THEN (TERPRI T) @@ -1073,10 +1385,10 @@ '(> < ~= -* *-) '*>*.*)) - (* ;; "We know that both sides come from Unix/unversioned, even if they have been copied into versioned FROMGIT, so we make a pass to remove the misleading ;1's.") + (* ;; "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.") (* ;; - " Also, lower case the directories. Perhaps can be done when the files are fetched?") + " Also, lower case and slash directories. Perhaps can be done when the files are fetched?") [CDMAP CDVALUE (FUNCTION (LAMBDA (CDE) @@ -1089,15 +1401,13 @@ FILEDIRCASEARRAY)))] (CL:WHEN INFO1 (CHANGE (FETCH (CDINFO FULLNAME) OF INFO1) - (SLASHIT (CL:IF (STRPOS ";1" DATUM -2 NIL T) - (SUBSTRING DATUM 1 -3) - DATUM) + (SLASHIT (PACKFILENAME.STRING 'VERSION NIL + 'BODY DATUM) T))) (CL:WHEN INFO2 (CHANGE (FETCH (CDINFO FULLNAME) OF INFO2) - (SLASHIT (CL:IF (STRPOS ";1" DATUM -2 NIL T) - (SUBSTRING DATUM 1 -3) - DATUM) + (SLASHIT (PACKFILENAME.STRING 'VERSION NIL + 'BODY DATUM) T))) (IF MAP THEN @@ -1119,11 +1429,15 @@ (TERPRI T) (IF (FETCH (CDVALUE CDENTRIES) OF CDVALUE) THEN (SETQ LAST-BRANCH-CDVALUE CDVALUE) - (CDBROWSER CDVALUE (CONCAT "Compare " BRANCH1 " and " BRANCH2 " " + (CDBROWSER CDVALUE (CONCAT "Comparing " (L-CASE (FETCH PROJECTNAME + OF PROJECT) + T) + " " BRANCH1 " and " BRANCH2 " " (LENGTH (FETCH (CDVALUE CDENTRIES) OF CDVALUE)) " files") (LIST BRANCH1 BRANCH2) - `(LABELFN GIT-CD-LABELFN BRANCH1 ,BRANCH1 BRANCH2 ,BRANCH2) + `(LABELFN GIT-CD-LABELFN BRANCH1 ,BRANCH1 BRANCH2 ,BRANCH2 PROJECT + ,PROJECT) NIL `(Compare See)) (SETQ NENTRIES (LENGTH (FETCH (CDVALUE CDENTRIES) OF CDVALUE))) @@ -1134,84 +1448,94 @@ ELSE '(0 differences]) (GIT-COMPARE-WITH-MYMEDLEY - [LAMBDA (SUBDIRS SELECT EXCLUDEDFILES TEDIT FIXDIRECTORYDATES UPDATE HOST1 HOST2) + [LAMBDA (SUBDIRS SELECT EXCLUDEDFILES FIXDIRECTORYDATES UPDATE PROJECT) + (* ; "Edited 10-May-2022 10:41 by rmk") (* ;;  "Edited 29-Mar-2022 13:58 by rmk: my medley subdirectories with the current local git branch.") - (* ;; "Compares my medley subdirectories with the current local git branch.") - - (CL:WHEN UPDATE (GIT-REMOTE-UPDATE)) (* ; "Doesn't matter if we are looking only at local files in the current branch. We aren't fetching or checking out.") + (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:WHEN (AND (LISTP SUBDIRS) (NULL (CDR SUBDIRS))) (SETQ SUBDIRS (CAR SUBDIRS))) + (CL:UNLESS SUBDIRS + (SETQ SUBDIRS (OR (FETCH DEFAULTSUBDIRS OF PROJECT) + 'ALL))) (SETQ SUBDIRS (L-CASE SUBDIRS)) - (PRINTOUT T "Comparing " (SELECTQ SUBDIRS - (nil (SETQ SUBDIRS '(greetfiles scripts sources library lispusers))) - (all (SETQ SUBDIRS (ALLSUBDIRS HOST1 HOST2)) - "ALL subdirectories") - SUBDIRS) - " of My Medley and " - (GIT-WHICH-BRANCH) - T) - (BKSYSBUF " ") - (for SUBDIR TITLE CDVAL (NENTRIES _ 0) - (BRANCH2 _ (GIT-WHICH-BRANCH)) INSIDE SUBDIRS - collect (TERPRI T) - (SETQ CDVAL (COMPAREDIRECTORIES (MYMEDLEYSUBDIR SUBDIR T) - (GITSUBDIR SUBDIR T) - (OR SELECT '(> < ~= -* *-)) - NIL GIT-IGNORE-FILES NIL NIL NIL FIXDIRECTORYDATES)) - [FOR CDE IN (FETCH CDENTRIES OF CDVAL) - DO (CL:WHEN (FETCH INFO1 OF CDE) - (CHANGE (FETCH (CDINFO FULLNAME) OF (FETCH INFO1 OF CDE)) - (UNSLASHIT DATUM T))) - (CL:WHEN (FETCH INFO2 OF CDE) - (CHANGE (FETCH (CDINFO FULLNAME) OF (FETCH INFO2 OF CDE)) - (SLASHIT DATUM T)))] - CDVAL - finally + (LET ((SUBDIRSTRING (IF (EQ SUBDIRS 'all) + THEN (SETQ SUBDIRS (ALLSUBDIRS PROJECT)) + "ALL subdirectories" + ELSE SUBDIRS))) + (FOR SUBDIR TITLE CDVAL (MYPROJ _ (CONCAT "My " (L-CASE (FETCH PROJECTNAME OF PROJECT) + T))) + (NENTRIES _ 0) + (BRANCH2 _ (GIT-WHICH-BRANCH PROJECT)) + FIRST (PRINTOUT T "Comparing " SUBDIRSTRING " of " MYPROJ " and " BRANCH2 T) + (BKSYSBUF " ") INSIDE SUBDIRS + COLLECT (TERPRI T) + (SETQ CDVAL (COMPAREDIRECTORIES (MYMEDLEYSUBDIR SUBDIR T PROJECT) + (GITSUBDIR SUBDIR T PROJECT) + (OR SELECT '(> < ~= -* *-)) + NIL + (FETCH EXCLUSIONS OF PROJECT) + NIL NIL NIL FIXDIRECTORYDATES)) + [FOR CDE IN (FETCH CDENTRIES OF CDVAL) + DO (CL:WHEN (FETCH INFO1 OF CDE) + (CHANGE (FETCH (CDINFO FULLNAME) OF (FETCH INFO1 OF CDE)) + (UNSLASHIT DATUM T))) + (CL:WHEN (FETCH INFO2 OF CDE) + (CHANGE (FETCH (CDINFO FULLNAME) OF (FETCH INFO2 OF CDE)) + (SLASHIT DATUM T)))] + CDVAL + FINALLY - (* ;; "Set up the browsers after everything has been done, otherwise if the user doesn't pay attention it might hang waiting for a region.") + (* ;; "Set up the browsers after everything has been done, otherwise if the user doesn't pay attention it might hang waiting for a region.") - (CL:WHEN (AND (CDR $$VAL) - GIT-MERGE-COMPARES) - (SETQ $$VAL (CDMERGE $$VAL)) - [SETQ SUBDIRS (CONCATLIST (FOR SUBDIR IN SUBDIRS COLLECT (CONCAT SUBDIR " "]) - [for CDVAL TITLE IN $$VAL as SUBDIR inside SUBDIRS - do (SETQ TITLE (CONCAT "Compare My Medley and " BRANCH2 " " SUBDIR " " - (LENGTH (fetch (CDVALUE CDENTRIES) of CDVAL)) - " files")) - [if TEDIT - then [CDTEDIT CDVAL TITLE `("My Medley" ,BRANCH2] - else (CDBROWSER CDVAL TITLE `("My Medley" ,BRANCH2) - `(BRANCH1 "My Medley" BRANCH2 ,BRANCH2 SUBDIR ,SUBDIR LABELFN - GIT-CD-LABELFN) - NIL - `(Compare See "" Copy% <- (|Delete ALL <-| GIT-CD-MENUFN) - ,@(CL:UNLESS (STRPOS "master" BRANCH2) - '("" Copy% -> (Delete% -> GIT-CD-MENUFN)))] - (CONS (CONCAT SUBDIR "/") - (for CDENTRY in (fetch CDENTRIES of CDVAL) collect (fetch MATCHNAME of CDENTRY))) - (ADD NENTRIES (LENGTH (FETCH (CDVALUE CDENTRIES) OF CDVAL] - (SETQ LAST-MYMEDLEY-CDVALUES $$VAL) - (TERPRI T) - (RETURN (LIST NENTRIES (CL:IF (EQ NENTRIES 1) - 'difference - 'differences)]) + (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 "Comparing " MYPROJ " and " BRANCH2 " " SUBDIR + " " (LENGTH (fetch (CDVALUE CDENTRIES) + of CDVAL)) + " files")) + [CDBROWSER CDVAL TITLE `(,MYPROJ ,BRANCH2) + `(BRANCH1 ,MYPROJ BRANCH2 ,BRANCH2 SUBDIR ,SUBDIR LABELFN + GIT-CD-LABELFN PROJECT ,PROJECT) + NIL + `(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-MYMEDLEY-CDVALUES $$VAL) + (TERPRI T) + (RETURN (LIST NENTRIES (CL:IF (EQ NENTRIES 1) + 'difference + 'differences)]) (GIT-COMPARE-WORKTREE - [LAMBDA (BRANCH DONTUPDATE) (* ; "Edited 25-Nov-2021 08:49 by rmk:") - (* ; "Edited 19-Nov-2021 21:54 by rmk:") - (PRINTOUT T T "Comparing origin/" BRANCH " and origin/master" T) + [LAMBDA (BRANCH DONTUPDATE PROJECT) (* ; "Edited 9-May-2022 16:17 by rmk") (CL:UNLESS DONTUPDATE - (GIT-ADD-WORKTREE BRANCH T) - (GIT-ADD-WORKTREE "master" T)) - (LET (ADDEDFILES DELETEDFILES SOURCEFILES COMPILEDFILES OTHERFILES) - (FOR FILE BFILE MFILE IN (GIT-BRANCH-DIFF BRANCH 'origin/master) - DO (SETQ BFILE (INFILEP (CONCAT (WORKTREEDIR BRANCH) + (GIT-ADD-WORKTREE BRANCH T PROJECT) + (GIT-ADD-WORKTREE (GIT-MAINBRANCH PROJECT) + T PROJECT)) + (LET (ADDEDFILES DELETEDFILES SOURCEFILES COMPILEDFILES OTHERFILES (MAINBRANCH (GIT-MAINBRANCH + PROJECT))) + (CL:UNLESS DONTUPDATE + (GIT-ADD-WORKTREE BRANCH T PROJECT) + (GIT-ADD-WORKTREE MAINBRANCH T PROJECT)) + (PRINTOUT T T "Comparing " (GIT-GET-PROJECT PROJECT NIL 'PROJECTNAME) + (FETCH PROJECTNAME OF PROJECT) + " origin/" BRANCH " and " MAINBRANCH T) + (FOR FILE BFILE MFILE IN (GIT-BRANCH-DIFF BRANCH MAINBRANCH PROJECT) + DO (SETQ BFILE (INFILEP (CONCAT (WORKTREEDIR BRANCH PROJECT) FILE))) - (SETQ MFILE (INFILEP (CONCAT (WORKTREEDIR 'master) + (SETQ MFILE (INFILEP (CONCAT (WORKTREEDIR MAINBRANCH PROJECT) FILE))) (IF (AND BFILE MFILE) THEN (IF (NOT (LISPSOURCEFILEP BFILE)) @@ -1235,9 +1559,9 @@ DO (SETQ FILE (CAR FILETAIL)) (PRINTOUT T 2 FILE T) (SETQ FILE (CAR FILETAIL)) - (SETQ BFILE (INFILEP (CONCAT (WORKTREEDIR BRANCH) + (SETQ BFILE (INFILEP (CONCAT (WORKTREEDIR BRANCH PROJECT) FILE))) - (SETQ MFILE (INFILEP (CONCAT (WORKTREEDIR 'master) + (SETQ MFILE (INFILEP (CONCAT (WORKTREEDIR MAINBRANCH PROJECT) FILE))) (COMPARESOURCES-TEDIT BFILE MFILE) (TTY.PROCESS T) @@ -1252,9 +1576,9 @@ DO (SETQ FILE (CAR FILETAIL)) (PRINTOUT T 2 FILE) (SETQ FILE (CAR FILETAIL)) - (SETQ BFILE (INFILEP (CONCAT (WORKTREEDIR BRANCH) + (SETQ BFILE (INFILEP (CONCAT (WORKTREEDIR BRANCH PROJECT) FILE))) - (SETQ MFILE (INFILEP (CONCAT (WORKTREEDIR 'master) + (SETQ MFILE (INFILEP (CONCAT (WORKTREEDIR MAINBRANCH PROJECT) FILE))) (COMPARETEXT BFILE MFILE 'LINE) (AND NIL (TEDIT-SEE BFILE) @@ -1264,12 +1588,8 @@ (WAITFORINPUT))))]) (GITCDOBJBUTTONFN - [LAMBDA (OBJ WINDOW) (* ; "Edited 20-Dec-2021 09:57 by rmk") - (* ; "Edited 15-Dec-2021 20:47 by rmk") - (* ; "Edited 27-Nov-2021 12:19 by rmk:") - (* ; "Edited 26-Nov-2021 08:51 by rmk:") - (* ; "Edited 23-Nov-2021 12:39 by rmk:") - (* ; "Edited 8-Nov-2021 08:46 by rmk:") + [LAMBDA (OBJ WINDOW) (* ; "Edited 10-May-2022 00:30 by rmk") + (HELP) (LET ([CDENTRY (CAR (IMAGEOBJPROP OBJ 'OBJECTDATUM] (BRANCH1 (WINDOWPROP WINDOW 'BRANCH1)) @@ -1361,10 +1681,7 @@ (OR LABEL2 FILE2]) (GIT-CD-MENUFN - [LAMBDA (TBITEM MENUITEM CDBROWSER KEY) (* ; "Edited 24-Feb-2022 11:30 by rmk") - (* ; "Edited 5-Feb-2022 17:36 by rmk") - (* ; "Edited 19-Dec-2021 23:28 by rmk") - (* ; "Edited 16-Dec-2021 13:49 by rmk") + [LAMBDA (TBITEM MENUITEM CDBROWSER KEY) (* ; "Edited 8-May-2022 09:26 by rmk") (* ; "Edited 10-Dec-2021 08:52 by rmk") (* ;; "MENUITEM is of the form (display-atom . extrainfo). The selector for the selectq is either the CAR of the extrainfo or the display atom") @@ -1378,7 +1695,7 @@ ELSE (GIVE.TTY.PROCESS PWINDOW) (CL:WHEN [OR (EQ KEY 'MIDDLE) (EQ 'Y (ASKUSER NIL 'N (CONCAT "Delete " LABEL2 " ? "] - (GIT-DELETE-FILE FILE2) + (GIT-DELETE-FILE FILE2 (LISTGET USERDATA 'PROJECT)) (TB.DELETE.ITEM CDBROWSER TBITEM)))) (|Delete ALL <-| (FLASHWINDOW PWINDOW) @@ -1389,7 +1706,7 @@ (EQ 'Y (ASKUSER NIL 'N (CONCAT "Delete ALL versions of " (NAMEFIELD LABEL1 T) " ? "] - (MYMEDLEY-DELETE-FILES FILE1) + (MYMEDLEY-DELETE-FILES FILE1 (LISTGET USERDATA 'PROJECT)) (TB.DELETE.ITEM CDBROWSER TBITEM)))) (Delete% BOTH (FLASHWINDOW PWINDOW) (GIVE.TTY.PROCESS PWINDOW) @@ -1397,8 +1714,8 @@ "Delete all Medley and git versions of " (NAMEFIELD LABEL1 T) " ? "))) - (GIT-DELETE-FILE FILE2) - (MYMEDLEY-DELETE-FILES FILE1) + (GIT-DELETE-FILE FILE2 (LISTGET USERDATA 'PROJECT)) + (MYMEDLEY-DELETE-FILES FILE1 (LISTGET USERDATA 'PROJECT)) (TB.DELETE.ITEM CDBROWSER TBITEM))) (SHOULDNT]) ) @@ -1417,28 +1734,21 @@ (DEFINEQ (CDGITDIR - [LAMBDA (GITCLONE) (* ; "Edited 5-Mar-2022 19:48 by rmk") - (* ; "Edited 5-Feb-2022 11:35 by rmk") - (* ; "Edited 18-Jan-2022 15:37 by rmk") - (* ; "Edited 16-Nov-2021 10:16 by rmk:") + [LAMBDA (PROJECT) (* ; "Edited 7-May-2022 22:41 by rmk") (* ; "Edited 2-Nov-2021 21:12 by rmk:") (* ;; "Strips off {UNIX}") - (CONCAT "cd " [SLASHIT (STRIPHOST (TRUEFILENAME (GIT-CLONEP GITCLONE] + (CONCAT "cd " [SLASHIT (STRIPHOST (TRUEFILENAME (FETCH GITHOST OF PROJECT] " ; "]) (GIT-COMMAND - [LAMBDA (CMD ALL NOERROR) (* ; "Edited 6-Mar-2022 15:53 by rmk") - (* ; "Edited 25-Feb-2022 09:25 by rmk") - (* ; "Edited 3-Jan-2022 10:47 by rmk") - (* ; "Edited 24-Nov-2021 16:44 by rmk:") - (* ; "Edited 16-Nov-2021 09:07 by rmk:") - (* ; "Edited 2-Nov-2021 21:08 by rmk:") + [LAMBDA (CMD ALL NOERROR PROJECT) (* ; "Edited 7-May-2022 22:40 by rmk") (* ; "Edited 7-Oct-2021 11:15 by rmk:") (* ;; "Suppress .git lines unless ALL") + (SETQ PROJECT (GIT-GET-PROJECT PROJECT)) (CL:UNLESS (OR (EQ 1 (STRPOS "git" CMD)) (EQ 1 (STRPOS "gh" CMD))) (SETQ CMD (CONCAT "git " CMD))) @@ -1446,7 +1756,7 @@ DO (SETQ CMD (CONCAT (SUBSTRING CMD 1 (SUB1 LPOS)) (SUBSTRING CMD (IPLUS LPOS (NCHARS "local/"] (CL:WITH-OPEN-FILE (STREAM "{NODIRCORE}shell-dribble.txt" :DIRECTION :IO) - (ShellCommand (CONCAT (CDGITDIR) + (ShellCommand (CONCAT (CDGITDIR PROJECT) CMD) STREAM) (SETFILEPTR STREAM 0) @@ -1462,12 +1772,13 @@ (CAR $$VAL))))]) (GITORIGIN - [LAMBDA (BRANCH LOCAL) (* ; "Edited 25-Nov-2021 08:47 by rmk:") + [LAMBDA (BRANCH LOCAL) (* ; "Edited 9-May-2022 14:26 by rmk") + (* ; "Edited 25-Nov-2021 08:47 by rmk:") (* ; "Edited 22-Nov-2021 17:29 by rmk:") (* ;; "Insures origin/ unless LOCAL or local/ already") - (CL:UNLESS BRANCH (SETQ BRANCH "master")) + (CL:UNLESS BRANCH (HELP "BRANCH MUST BE SPECIFIED")) (IF (OR (STRPOS "origin/" BRANCH) (STRPOS "local/" BRANCH)) THEN BRANCH @@ -1485,23 +1796,26 @@ (ERROR "INITIALS is not set"]) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4721 5567 (GIT-CLONEP 4731 . 5565)) (7335 9315 (ALLSUBDIRS 7345 . 8513) (MEDLEYSUBDIRS -8515 . 8954) (GITSUBDIRS 8956 . 9313)) (9316 14790 (TOGIT 9326 . 11474) (FROMGIT 11476 . 12454) ( -GIT-DELETE-FILE 12456 . 13350) (MYMEDLEY-DELETE-FILES 13352 . 14788)) (14791 16940 (MYMEDLEYSUBDIR -14801 . 15247) (GITSUBDIR 15249 . 15572) (STRIPDIR 15574 . 15945) (STRIPHOST 15947 . 16183) (STRIPNAME - 16185 . 16938)) (16941 18469 (GFILE4MFILE 16951 . 17197) (MFILE4GFILE 17199 . 17541) ( -GIT-REPO-FILENAME 17543 . 18467)) (18518 29311 (GIT-COMMIT 18528 . 19106) (GIT-PUSH 19108 . 19664) ( -GIT-PULL 19666 . 20072) (GIT-BRANCH-DIFF 20074 . 23895) (GIT-APPROVAL 23897 . 24098) (GIT-GET-FILE -24100 . 26400) (GIT-FILE-EXISTS? 26402 . 27229) (GIT-REMOTE-UPDATE 27231 . 28273) (GIT-REMOTE-ADD -28275 . 28582) (GIT-FILE-DATE 28584 . 29309)) (29356 39349 (GIT-CHECKOUT 29366 . 29607) ( -GIT-WHICH-BRANCH 29609 . 30193) (GIT-MAKE-BRANCH 30195 . 31686) (GIT-BRANCHES 31688 . 32862) ( -GIT-BRANCH-EXISTS? 32864 . 34061) (GIT-PICK-BRANCH 34063 . 34517) (GIT-PRC-MENU 34519 . 35819) ( -GIT-PULL-REQUESTS 35821 . 36717) (GIT-BRANCH-RELATIONS 36719 . 39347)) (39379 42211 ( -GIT-MY-CURRENT-BRANCH 39389 . 39562) (GIT-MY-BRANCHP 39564 . 40483) (GIT-MY-NEXT-BRANCH 40485 . 40926) - (GIT-MY-BRANCHES 40928 . 42209)) (42257 46149 (GIT-ADD-WORKTREE 42267 . 44149) (GIT-REMOVE-WORKTREE -44151 . 44729) (GIT-LIST-WORKTREES 44731 . 45535) (WORKTREEDIR 45537 . 46147)) (46197 73219 ( -GIT-GET-DIFFERENT-FILES 46207 . 51527) (GIT-COMPARE-BRANCHES 51529 . 57321) (GIT-COMPARE-WITH-MYMEDLEY - 57323 . 61081) (GIT-COMPARE-WORKTREE 61083 . 64560) (GITCDOBJBUTTONFN 64562 . 69566) (GIT-CD-LABELFN -69568 . 70650) (GIT-CD-MENUFN 70652 . 73217)) (73289 76958 (CDGITDIR 73299 . 73995) (GIT-COMMAND 73997 - . 76071) (GITORIGIN 76073 . 76650) (GIT-INITIALS 76652 . 76956))))) + (FILEMAP (NIL (3224 15673 (GIT-CLONEP 3234 . 4497) (GIT-MAKE-PROJECT 4499 . 11213) (GIT-GET-PROJECT +11215 . 12552) (GIT-PROJECT-PATH 12554 . 13598) (FIND-ANCESTOR-DIRECTORY 13600 . 13949) ( +GIT-FIND-CLONE 13951 . 15032) (GIT-MAINBRANCH 15034 . 15318) (GIT-MAINBRANCH? 15320 . 15671)) (20524 +23312 (ALLSUBDIRS 20534 . 21820) (MEDLEYSUBDIRS 21822 . 22515) (GITSUBDIRS 22517 . 23310)) (23313 +28103 (TOGIT 23323 . 24729) (FROMGIT 24731 . 25712) (GIT-DELETE-FILE 25714 . 26560) ( +MYMEDLEY-DELETE-FILES 26562 . 28101)) (28104 30636 (MYMEDLEYSUBDIR 28114 . 28570) (GITSUBDIR 28572 . +29015) (STRIPDIR 29017 . 29388) (STRIPHOST 29390 . 29630) (STRIPNAME 29632 . 30385) (STRIPWHERE 30387 + . 30634)) (30637 32539 (GFILE4MFILE 30647 . 31010) (MFILE4GFILE 31012 . 31581) (GIT-REPO-FILENAME +31583 . 32537)) (32588 40339 (GIT-COMMIT 32598 . 33424) (GIT-PUSH 33426 . 34070) (GIT-PULL 34072 . +34684) (GIT-APPROVAL 34686 . 35035) (GIT-GET-FILE 35037 . 37506) (GIT-FILE-EXISTS? 37508 . 38452) ( +GIT-REMOTE-UPDATE 38454 . 39178) (GIT-REMOTE-ADD 39180 . 39487) (GIT-FILE-DATE 39489 . 40337)) (40369 +49297 (GIT-BRANCH-DIFF 40379 . 45082) (GIT-COMMIT-DIFFS 45084 . 45528) (GIT-BRANCH-RELATIONS 45530 . +49295)) (49342 57178 (GIT-CHECKOUT 49352 . 49864) (GIT-WHICH-BRANCH 49866 . 50164) (GIT-MAKE-BRANCH +50166 . 51399) (GIT-BRANCHES 51401 . 52378) (GIT-BRANCH-EXISTS? 52380 . 53397) (GIT-PICK-BRANCH 53399 + . 54188) (GIT-PRC-MENU 54190 . 56157) (GIT-PULL-REQUESTS 56159 . 57176)) (57208 60548 ( +GIT-MY-CURRENT-BRANCH 57218 . 57508) (GIT-MY-BRANCHP 57510 . 58546) (GIT-MY-NEXT-BRANCH 58548 . 59142) + (GIT-MY-BRANCHES 59144 . 60546)) (60594 64546 (GIT-ADD-WORKTREE 60604 . 62088) (GIT-REMOVE-WORKTREE +62090 . 63020) (GIT-LIST-WORKTREES 63022 . 63826) (WORKTREEDIR 63828 . 64544)) (64594 92310 ( +GIT-GET-DIFFERENT-FILES 64604 . 70330) (GIT-COMPARE-BRANCHES 70332 . 76046) (GIT-COMPARE-WITH-MYMEDLEY + 76048 . 80505) (GIT-COMPARE-WORKTREE 80507 . 84380) (GITCDOBJBUTTONFN 84382 . 88872) (GIT-CD-LABELFN +88874 . 89956) (GIT-CD-MENUFN 89958 . 92308)) (92380 95363 (CDGITDIR 92390 . 92768) (GIT-COMMAND 92770 + . 94356) (GITORIGIN 94358 . 95055) (GIT-INITIALS 95057 . 95361))))) STOP diff --git a/lispusers/GITFNS.LCOM b/lispusers/GITFNS.LCOM index f2f930440136faba2d0a3c332ea7109f14a8c7ea..a06f9731feb2bbf3135f78b51abc45c1904bbe2f 100644 GIT binary patch literal 39766 zcmd6QeQ;aXbteGIl1*DQNh^xXILb9*$&g}D#1}~^jtme01&{z91c0I#f6ydB2{b8E zOHy&PiMvUfNjux78Kr_W?qVo8*smBJjQY?z)pAfBuVho1T56)uQ9O~VW>sY5RBvyHT1cZ>Et^rnNGx1jxEYR) zM5B0oE)h8wj|WvKxU_NY`pVjJU2UwZpz8fZraJx7lQUb(n_K5s7p|`@te-DzEG?{^ zzqVXoTfP|^PMp7XGb}gf*H*T!-{7hj^0moQb@;>4vGG&rE9&$Wjh(~)<6}X!xVdaP z>s8AizrMM3;+$IF*lw(>UsWsUeR8HyQ0{k!hlhizzOaqab!jsZ4W4>ell<}L)T_=W zV&kLgTsoI3UC36$HA{ukR-Jf%XHQkAL_Sm0^(lsZ?gWH05dnQAx# zH0;AdJaI0P_(?#0>{Kth4W|oMDO*mBjEqFoxy*QPD6d9T>Xh;g`g}fras$7fF@YR*=GXS>Jg|uEq>lu|- zQI*bRL87H}wu+XjD2k|(m912)3a&>~&Z^eVpd*arX}{0clibZ;r4c0gmwz6hdmh#b zk8r^6%XN(R<=p2dZXeEZb*?km8c4m|=;vxlF2R(>$CY$EHlnbQGGQ~Uusu_ih;>do zKCY*&VsTY1q^h}mO-095tulkue|CJ5^u@JGfKmXeCZ zc=BpYO<0*ZR8`|q6)agbm7-S^V=SoRF%>-H26Hhroeh^O))a8#!Y2=-nm>2$^h{}% zCWk6DR5`86Dy9kyY<`?BWK*S?a(L3J6sxDzq{6If-~~loCKOs6#X|L6J`nKv2a-KC z2K=pKHHK|Neh=S6D0#XykQ?O3jiui9V+Z~HeDlKItv_VAPcz(awWnXtx9*#249$I~ zd28zAYt7&Bg+|Ay&$3ljiKr@J>3}j~XVo*sOJHGu?pe(K9I>%*0Sr$8Z`NcPAOeRv zhs*G#RAC0Z49kx07^z`;u0|s&_(4sNoq)o-MEH}SI(xzqd%}IbfX`Rv`CYu9rblZa zLgN4;s#!FiQ0Gz;Rt4lA5`uSkV8|Y?FbDy4tQXx+S)El`l*H9+nb86KmQ%GHuA@q$ zl3pOZ=P#733RT8xlQoNadAthdpPDJusxuRyR$53gmA#xU%vAGMiEg86)~ZZ{>bPZE zXS!v5KVt5gQYOJpnKE^yDzFcVBmzeBX^4tcrIMOEr2=m~5b)iTWYjMDQgvtL?Otuy zxmcEE>yoTl#=5)w{PP4(S&CfFmz}G+_1;ut@AjZnbJ|!8-0u0zPM|hWKESwfep1|) zbI(ZQR%JYkf%;0F3tR6?rntqYTWHJo58Q{8T;}(=fUk1Su;#e(SJDHi`-*(|ho!+h z*W|YNr=$19gA*%z-<;suf8;!qmRI@R+_kqG_4@44%HewnDm*?JPcF6EsISZp9X>=4 zS_iJZ&0Vza71(nn9v%NQw*zPEGdeyjiFd|!L#PQYpXnfjON0^jCI zO!kY7<_CCW6Rku1mw%ED6c+_;B4FepPfNhh1w5*W+d*8W053NqtP)VEk;Mib)5v- zcGXFog;ZogsuH6{Bqc^;c42Hp&6JF!Nnnt+c;cm-fN1szpEw3toCdGK;#cv6OhlN6 zipPnM2oF>7=%~$O<56ZeVK);KaS|UHQ&u@!Qt=V+jQvs#oH}8~8XHfjLYUZvij9G( z&rIlH#4s~l5{r*Pg1R06boxQ`EapsnzGz*_hBGteLLS;hwyK~js%KJVj3E=nP0V!@ zk1A-s;8I|nv9Yehivm6(=Obsw+&nJKoG=14z!AwRg1!u_BV%C4t_efJi~$wyA}!ff z1cJ+hgb47Ydqw{mzq)^oi?fjqOhRwe6~{&m7`^C2FEge58xa z0ByuwD{@v9v&9KW^BG1B1lB0}-q>8Zy0U)e+QQcM@}?REy6h6@*oiUGRE#)^gRn*3 zsW=2J_0~x$Q56Fbk@lius6t9j4Dyc`LKILIQW(x&oJkd+F`+#m7t%eZUy9;wrs&9M zR8_LInMw(89dm%BB5^cpv{2kdc%BecqtXkst70}&$j+e>sGI7t77!a(!Iy$qjZg<> z@fV{Degc0-piH4W0l)_@&|f@9c>A+{3ZbMApXSTDwtkae|%eASy`{EYd6)4 z8=I?SkknUTu552?-c-R}tc4L3JRejsD2_qcKez%mf@gv%iWLwF)|c0oVWr?cczSs2 z=GMlI?cgaD#X@A=dFAT*#^y3AkDT>%2XL#UwT<;<8Wp;UIL{YkK=RZXi;SKogubBQ z28V~wKsm>NB5@Uh!metkL~Q{r8U4|i0#OM5Y=IPZuXb*TfpjLK0Ih@AuR~|xa-&2* zar{;2Q9a3ekDqz)-mT*-J6b*Ei$?>jl>c*=6j=1#-k7LM&0lIK1O9%wekBR6?(a8` zUcn>#*{k%-_3%sdkW1v8P_lA}B4U@+D#a(2c;NZS5;E z0xI-sU%RZBdG@OV=vAi5*-vCr=uDY7=D^^-bIV{eFiJg*W zSez3zkP)V9-$l(M)OPB0zK;j|zJMrDP?N6RaU?BY{dS6R#Mg^~wjj(A!~+9@ za?{ z6#{RHk74QD&0@6iV~~^5SjlE4OSmK}AXTXmhnj?v-US@m1mT;oBz!hf^q@AJz24e5Yx;Fw5W@Wsb|o3wgP!x%3iL~ ztYOC4WprP~GQd3U0#`ijoPpt1?`YY81;wF12U14)KdqI2b3c^gS@0xUhZ*Fei~_82 z!y6!A?lLYi^@$aliHd0StXMZBXpX`oJ1{{!fNc9tgWs5zHZRijg+)IBRKZ-fy(bY> zu+k8%gh0btlPczigvTcak05AZVxJoaL?;X! znDD3=aICoJz^lT{NO0ne&@2@YpceDjHtH)^ZmMewP=*#a7uJ^=SVE~nK{##IHt?~Y zr}Jg39=LJvJBC$V27`f10)OL*jQWVa6ZaMw=Qe^+8^GKQ={zz{5 zzrw%u+#_Gh4P9>M1|s)N^|X46VzKr6zdOy;T;N~+;nlm!&>ML4-cnEN!G{`r_r_G< zqs@QopYLNJ?>=jZnZ(cL#dotdymu?h;?h4b&})hROjl@IgFUTqWAN5vR{!d?x0$rK zCH|T3FLJ%FTm8kMH%o!%nm_BGKZ2T#mB#E*krS_4M_RwT(nLdn`N8IGAKW<+&AC(r zwg7SNY(+(2Q#kfdWPHS^#u2Ef4%dr7<1&(itgakxB9PqV+Y_&x=rk<7jSflbCcH6G z^-PK0jVfsWs7}neQ}>6iT@`On1kwaG#1{(1S;6d!irxzuMADv?Lj-0Hvt7|hJIDrZ zMUVlULk>Z?r~=Di;sBV|z(^p~8W;L+j@11F{vO6D(*R#hyF}^Wck-=6xyH~(Kb<@I zTA-)(AE$_gxq%0*#%;V1={WsFw61&9z4r7AhFcqrdGFx6l0`P!R}pZ33*54=`vTzM=H9%(L=?C01=sYoi_+=$iX~a3eXnxG($C-ZJ*)4#)2-e@W9aGE zckav=PQI~oXAX`|EQ2!K2Qiq#wsRsfilszq8o86LSrB*}3$8pzfMFBt0$s%!P*``` zlkq4k&$=<#U1o`nK+?M!I}2Tp9TwU=96xK@_3&nR&^|h<`8^gq2~qB!6+N>24E|vB zlE`v6{8Qx5q@vke9v&U7*^80u6>OM18?l)BrEG=#sl1-C(1U7eVI6@ewYaR7HmneKu&Xb#DtdMNYdzs$Hd*La87Z{uBXY5>v& zn-ZFei~vbpkOxc6gFE8c`!GX9lgSp~a^X;`(PeD4llcR^1<3c4u9?)@i|{=#VT=+D zaKm0@kVki_w>T%v$K8#sVSvh6RJgSz-P^Adk4>gXFJSB}`uLie2p70q@O!sE264iV zoFA8GmeJlUF^?7{f_aBra%23%?~2sn`)^4tzHU!!XvQ9w26&nTHy#8!-9mf zXK9mL!_6Q7Q>DNX33#}7D!CP<>P4rLW0_MUV|>+Es(fnt&&RDhRZoD z?Fc*~yx`BCb%{S%gN`groYnF@4q*?gK=TE%+S$5??rY0^==Y$h8*6oD0OIfg@j;<6 z-k7Ir@xNo>_ zUBxwAcGr!g8hovSqzl5kMu>Iv^&eNOQ z&X<6q(+8{#cr$fR)TU8+U>K&VkDzxS`|YftWdy}ov4 z?-$#-xnKBp{!2;ibikx@t8aa$`4(II&eSm&mxskWYcV4CP1`p4ei9RBqm!_x6%ZTY zZnnwd1d#q9h*DS~_@xk~=v>Le2l2>fyQX3eDT1WjjD{ABW(wf$h9B5;hy~7r5z*Ck zF#M=GXj^Tj#n2TW@cNq=|u}ZdVu?TaBqpJ#mK@n#O*uY`BaLbZc zMYR0_$sRwCkE;mW7JU*22KD?(axK757JZ*eYQG|k$}cC4#mH+2@i2#wVC}gGNsYNF z9%h!d>!1u69zo$Ga#heW2d{H`_TYS%XTqe(x#SiNK%A#QaLRSZ4gVAW3uW*)CWLJ{ zXpM{-p_NRE4(DOuItqKDTBTep0&y*0gSuxp4ykA>hkU*RX$GDAGMIja**BMpo7Ghz z%{2!4eaV4~2icnF`OW;BjnC%AoRG&{|2gRNS_}JA(!#J-5#ca#GQ0Z`ukgggib{cw)asN9uoL1BhVYl&Uc^rKUBm|fi^mkCJcb=5tW ziTz2E%LEV290ijnu}rt{8>hq^a`y0VBdVidQV|AyD+GZWTK zO;L1Pr#->Yt-_m*fpKyta+wH7bT2uASh;k=`GN>`+Sl-VN?VS?49*5J=M+zvv-Ac^ zgtZZk(5p7k5tr?r7eyJHz8@hk%F}~1{!SR>q%(3r07YQzggr`GOXC+f#BT%$Cx?yT zlbC9Eg3~#543`s^(&M2q8DG2MXjm5}9JD0b}JUb^UH|UNWALmNh*|5=1 zFxYc>BlD^Tx)0Jerm!i6)7gfMtLhw?LopS=p*U%%(I_3phr@)JTc}W}&ZL z((8F>!jzWjnA1bq%5~8FJp&WSAI=hL3 zwiGfvg6ELt3KtoPsjbGwi!h#HeR@Jm1T&MA#f&?8q92G3I(9oM)M=d=+v!ByT<9EZ?u*3$@Ev{!^y7AKXsxU(qt!ZY8WO zURi$J5FL%*T=KP{Y7 z^h)k@*a!(VK8h?v{O18W6iOjc;;1tfiGY)e0n&e%lvW0c9nK1ywkVAK(q{JUySajjJjg!Gr6Y%iG&GKXM|7 zw6SXo+viT4SjwEh#AT8)3+#%RoHVQe`H5fyaDnR#B+APt6S&*-k)nzDOCu3vkWU=~ z1d_icTmiByWiA8lhJa!pz8ZA_i_LlckcxG2*320}ne*q3sC+s3DKYsFAx|Adg#7;L zL2aw}pJU|L*HU}Ck#56DkRDuqVVh<0tHdUu*sz@eCfQK0V503@E7Kh(oG!*c@ zF1oO*!feCBnMy;BC|I#t_4F%k~&_Uv57J#n!YHgJR>nP5H9sZRDc5 z-;P4H)@d!2I_qDnafSFLX z14Nw$BgHRtzc5kt6{Mz{7a`X`!xrL~9(ZIN5;?eVpFhAUU_qQvbI9GL3}9m68Tjxh zC{)hlGD>OyZ>+=h2+UiK%4IkP3n7rrkdWq#-I;aTLwI$4<)30pAf!(i$vjsOv#le! zmQv`0D$l95ByEu4!@>uf8@HaqlLT6ZdkP62)`ikX(JiK;h{1txB2^^#;=(4q02`wh zses_DGEz1~0R8cRkY&VeRs}|Jyjcbd`n|OfC#^8OBeH?y72z}qHF-$a= z-v25RjDc!;H%c8FSWq0<-E)*O7pW4YL(l-Jvr+`AK#-xfulw;xFCehKy1wzENqz!c zXgb=uTDZ2ja`nc>jV-mXdG*G%<@Ig#IOaoAMnpOZd zlJdCY5P6-|;pgI}Vw42!Ren8-@yX%b^)OhhZv;7&Lzmp z9?wNj=Dp42#O-SS$-7_y9DQWnCuw~Be8;439R6gSxJHNV;DI&jl4BrACX96ARKUqJD@d+^ z>GT$fQJ7IdEQkU4vGDbU&8=m~fQ3bD^8Z+PbNLE%q!bCu4i67+E)tL#J{N(Et76M5 z_z&%f%Rrs$6b~F{BdlZR8yOwi2z-US5N?ZO_ox;TOuYO9X5{u$aG8-E@TcW8xsR-O>8tVv?>MP_+VUkh- zdVnr9Tg7yM2wJCp0J%)W>%lq}l78xF#DYBRE1?v9P3s1S5%S2*tm8BWY<3cz3cAzQ zjkRsEDS_dIwaw*)`c0hIu(GwiMQLzQl^$2#;$d>0K>5*XM9P@=q$AX!Lg4rWyrpie zvr<68-yrk~D8Rug)F_Z~ox+09q?TVaui`oF%_0J`$vnJ>Mxeq5Z9lM35=>O4b`oWx zn}U|&I&I!aHE&)Q3p6Z=Zy_( zFS-Z3D6)wYAt=f+K!P*031bdouXqGjKh~bM9xdVEB4VLGC-Njf;qj9P4i~6Radh$uS3GwEMXiHKy8Ke zMi&w&E6XMz#RKYnaw6YEx=F44f!w#_a8k3od&a7T!M7F}Ck zAr57CEH*4LQzcUfot5|NaNTNLG^Kp+zKl zV5BG4JWlKTK*1!_48AtiI+RCJ_NVhFUx!NeSJQ)y6=5s`j~*(L+KYV~@NF&hS^YiO zqCaSRx8{$b5pl7g&d~0AEGl3EwuV^4Xnu%`bV4szIljn{SFA_4 zA-?&v^$6Etek1K4GaViCvlEjrJAbr|Z5|IV?fhueD2j=^C?i8(~C+Cl}n}1Kc zK5PjVg)WB`VpZ}N^4R-(*70p3X+^jU6h|$$D6O=bs#dKu1dyW|VV|Hb9oLE>cJn&R z4n7HkFwrG-XHthUHc;c@47Lc+ezXWAkRT2#kG7`-mHHs;YLaavVh}^a(Ma{pg)7^q za7%1UeS{uRq(GfF`j)3zLvZ7ISJ0Tk;Y?VNAT3;w;f3vqsR=T;K$3LcNvD>RFX5aI zcsq!qh|u8PDxl(|g~j1lyt#--|kZC){%nMr~Q=Tp}SQ|?j{PWMeTGf;Qf-h#;d3;-bm*?UgAGra6f!w zs&#l8dsSY`1upO0S)4xkI=S*_=eLnF5n_)~p;piGN+;k81VJ>0?801 z9oQ^kXTUzTBMpNvmN-}Zw@gNq>=>aGQy$cSU+cHLwp%?ftbTuBpeL7{LiQ`OddYyj z{XV9Uq#UL3bn9?(D*ydyrk?(5ciwuV`2#R+MhoA#jW=y_0_jrMqoQBwkB70TZiodVMn@k+ux_-;iPfX=LZ@mFv~8;Z ztk<9gUU`$TgFw?_g#UhE9I(090 z$^nu0bTmO=ZPGqWIH9AI+Yy;=o30drc6MYe!A?a0nvU<--dyGrHArG3s~}k3T!w>! zf&u0!9>BfIvYtdb*&*hU;xI6%i$lb)Tp=g+Jr9Sk-dNt+f}?|j-^gUaSd4nk8^I9S zrcGi?H#RrPjV`7URC;*u^&YYXcIfB_Lc!ujb5bp}RSP0!q9yVr1a<15HnnC!t=Og{ zN~qotZ^u@dK8zn~j%gX)BIy;nx=h4fw-DZ%+ z0T6o^4T0}t`*4Q%mGLA%OykA_e*KOX)pU@Y4KJ4)K%^)XE%4hHDEXh~D>CuoJz#Xb zd2Nyy^$F*7tw`kg+1(h|7L986q_)7HS#_0aT?p#V14i9xew(x%Fhhj+Y;DC}e}Jd6 zh+r{lm{JT<7$Gu{9V;??v_&5i3l`V5q*ly}&LL@~}ZYrHx5v4E1i|SQt`i z+yt#P8#juyz34S%Y%(J8$-4x2!b$fQB+&_2d*ojcZIo-juaR zK_Hwx0M&|eEL<3y6wO$6R*=(%w%sHBRqvmqtb`&mn!#JhUZaIT(WK6lJkTG-CV0y* zC6pp&voByl(Hk86APtvbyZzZgKN9mA8J^stFJ-Q<2T#fd9u4H^fI5GRrQ@a5x0W8@ zD}Ljna#~(Sn@KEL8FIp&dEHIidf${l(_!n()fW%6)8?5daa>KF9c<@z{4sG7`Sk%h zyCd!Cfd7r;^n{$exRQ}>zPRH*l$uU^3wL~f?|p4wjW6!_{&-(oJH9u}YvJy_wf8jy zyFxrC86UQb+ z9X5xEf?o`pJe>hb$DnBs7@Y#8YsYYkCmmPI8P74OKb~e|lvpXv#VGSASB z=RH0uP2P)kWKv3yTtCyH6uZqR^lsfI*|6R=u_aqSi{N-L&$9>;H_bD&X)eL&ogGOL zIOfa)m}Jfacye6F-CXu0$h$8vTM9RsAHv#boup#kp1fgD{^TIx%*E-sQ^#|rOQ<^SWvn3t_kEfQxIbozC z(IH7I5OjP7_e~QkRm_@4KGWI-ZH<$!&D}uxnsw=oq@B?vAl_4CI+rMMrPBH@eve?vbBI zuRQpPx>cb_IO~{lrT~yiCwIsmIjmumgbtqpm%+tkia;2Aa2%aJ$HEGjB(%#NsU3uT z(hEQG5mD*Xli|A{*BBUZlN)Ril1q?ml|1AcVH#)?S(VPnQMR42b#t)K-J}%xE}`G( zm7`mMz*;>3SFHqX7Y` zsEF#jUywqC{Of5EL322!)BkiHE~tMm&+`7f7K%(nEYvQGbP!>{tUnjP8(+*V-79j` z9wYaq1A2U&lgKn*ALds%-+lt9xJNYM&Qa?Y#Ya ze2bSPoTq;gvX%5hkg_pqQM&S173r#tBIb#sA@kY&*5EjwE7O zE#yH)+>=fzg^@}Pko^h%0`U<#ubxyt^$`_5txkte!4yR+lgo&MQWXa#=zznf(j=Pz zTQ?TXS&%D$;l>rT7>^^X%jsgl*#Kw&F^f|R;f<8TC=BBgXDbMfSQXO6c`GXsBj{O9 zxuP9Hd<-?!fD!?Tg$oj0^4xieT~*Q)LNr?8-p3A$b3_ejgFT7F98E+YhdtQaYT|GK zvHn2Jax#C}EQvWPB!wTDi*z719OYs`kdj|T#$dX}f>nlGg&@^=Va06aLe>xkm*X&7 zVygxsVa-^P#}xRJV*%g6Ec2Gd-pnsIvdpL2IO+10df;pRMc=K5vXG+Sb2>yuJD{by zudempueNmqK2c2Jjb-MOHO!aWd_gKD2kO22RCC%~7cQLdQa0`3%&uLgVu5Giy<>e!KGu!d!pdd&}S&5bd2(zzHbeQ&5oRoVsapQ#8Oc8f5wkA zD=XMK{!no#s&`AYr@-2gQ6_56j_>WBZ(70mP`mN7R?v^XRxp5ME$&gy`j#wdE5t?C zWBcUH{7IyCSts+b^@mtQ$ma{>6csDPMb1ywmO79-PBAymw|q67m6N)^!FQjMcfq!*o|OZ?MG+Ik8}wRRLQ0oI_KASGIhmpHhDw8m%p zlU<}6=fo{zM8W8BEQctch|J2eS=}V?q6pBSf6a5E(B91oHAPU-bhl*Yq%*vo-q8`BZeMIOGog0%=+f(HYK$UnbB! z%REOUCg5r^;xR!EVBz7EKW$iZ0>+*Zs&T-^>7Ft|NP-|phgp%R93_JZJ{>yqJOl+< zh88}rLK!~v_=Li>9s&j4CrhVJp_P~leNrlLM#q!kPj*zoJRwObZQBv3y(+%xWpd(V8A@8Lij=_=oGOqblKYr&zqLfIBgkrWl&@&2X-A9 z3R@44iZ}5XDpHVAQoNG4!zeJWH6vTGCW<7SL~u@+OOj_&DBHSq)-9$?Cr%(WSU(0i z>nl0r2oDp=s^QE|DkhVHO!{J(EJIU5-ou$nn!i;-H7L7-&bG2EU@I%7(wq7?gv-(4 zIwR2;WQ5pK*re28kf7Alreiqlap)_5mg4j&)f4ac<9yFs51X)v&bre<5`8yt@g4-8 z?J7C*RLdY{gj%jm2;*dtWQvUZ6wa+nyO}LUh-wQZCo!9W$bC2`^Ft503=~gGdK7sU z=R3ZyQ!YkQECZcY!A~GIb6rX)2Vys44epLva?0j6tv;NQ*&Maxv}@+&+`z2j>sPJ5 z!q9h{N3Fi;p*KEn^}k~E<%eGTtkpL)^g2$~+_`g!BxCQI`Jw|7E<7@ygz8^R?Ox~t zJkLy;!FSQl^ltd>?M(Bq2T~7ON9T|Av_9}q0cyo=m->Yr-DXimM&B*rRH>_jzz?bydh)7o1xwG~zW>~y^V*iLmHL_=RpwWMq z;s0pkW&zA3YzE&k^ybeYTmVrvo5F^1SeKN$rve#L%Ql}am9f$NVWwzQ7 zhuUBYAvMe;lq1~`tSM?bj_FDG8=^|rBCoO3ib0r|LLkdrlB1NB4*G-!wGsmXa9R}k zgSGFOzO+ERn;gz^a2|bmfIbE1@O^N7jMIRJb_;3nkbl?>o+uz;S96lAqTuhIYH)n= zY-sD59xW+bGTMkk6XZ}M6+m9qEl&b~cA0p}bmqNF@@X5T<)MV?~|;owc=GB2!OMY=OP5S~ysw#ek?6%ejwu@fx;0tyzF=~H{y z)~3JArz@{-a1lHSTN~?JbeaNbGilwTehHtR*jz&Nn;aD9;DCrBsXQo(nC=zH)9i8z zrs{Pw5-tN#82<$&UqLmJPl-VHgJ$K@jyRf^&R7#u6En4%Rf6wDN2x(6DVny@0uOn*kSDY&TZ@bJ-G}Ncd*6=rx9;aQu$5N2 zY78~caT{{5Fbkq${q{-JzNJuIjw7JzUnu>i)pvV=TT8a#5KU7w=-;He{zncU#+Ny11Nty@Qq^tO3^8g>Bg zx7#Iuif77$=ohq!(JY}-o#N2%#S)qRcP_XF`^B9*<8GY8W1)e4TogbjWXluc$u&PH zb#9AiqFWUJ4#~VbZ~wVz?h%}$Yli&1d$^5$Q{{-(1hCVrPa>Z7qlev(xN{zj{#eTG z2TRzt)>nT;XrW*Jw3~lNr$CS}ffOYk0=ZA3$G)QjT-?e7Nh-H;0Rt;tH4f}i2psp* zQJ9+fB96PmdIM9#vIf&NA^A}-3@uGcA$-a?;}#6dIN4rzuH*3)=`cy_iX z%bfOgbC(H7*GOk?h0nj_p`X|XgdxbEC+^@ z!OI!q^x-Re2Lt^0=&g9pWkQ^;wN&ycG|J|my1Lq5B<_&_{*X3#lvY~>;D zCuf_`S#|sShfV1LmV~rP48aL4I@B0BGE$WkHWQGeg0(Ex7)LqI>(;t}NYV&-`!!kk zHcpZIg*5FPP)45h>?AIrMBlSAP7`P>EOiVR*fj#2hh#`5 z!VEVFJPl7lWP(N^Gq2xd&~mC5q&xIY{Q?68J7S=k?V^$BLskI#KY9LSP6 z{kpsqkXJA7K9VxW{K{Kzn75E;+v-V9x9~+26Kj-o>o=Nziv&*aXw7P%|C(?(WnS9Z z@z8h;w}OtYy{zu@xj>&_zsBJQ{-XVTM7MM@Ho5e~vu6WVymz9?QSb%pgMsJ7H%SSj zTCB1W0BaL`NxR|8T05f?*lci{PazSIg+EHJgT@mjI|%j=)K2;iVhcG%Rt}_W0lm;J zvsO@%{6xO)m!h=D=Ub=5Q^Z1hhJRUX@{bnb2$1{!vMNV8KF%7&gk(C}vUf@MQ@wjX zA9D3m6MS~>?M9_rPcoF6W(GUdVTJOJ8^+%MqWrfE0BPfD(E;20+50bH?Dqrf2k~ z*BI>AeLaB%OGjY%u70q-q8w1pXlAy$Kmjzfvk z>en86^7w1}k%G-6fAnW9bc~t493rn#c9nUJ{Nf$;AmoEH*b4r*ZkguxI6m%tNl6((5p--VL7PrGHJe@OtW$J8J^~hLjoH3iV#!Y1`xIb? zy+mIL@8z$A@7%eL&xG&Xc>(ecS>ZYhn$|Bi6F46Qr~T&USilH)muwvX+3Tf=ppSkP zq_3~AH0ev?P;$%>r{x;9HQ;$;d2J1jjB7;YP97#yP<_NDmPiEZpZn|M5UQP@A1Buq zf7eqIG;n;(l?7-|_-YJ=jV@sIz;(lYoCrb_MA_BGISSu#**d--b7cd2;XzM$#CztQ zc#4qX3{9J;bWX5mIY)qXJ~Y=G@^$nt zq#Eh%O+vIj`I?E;0AD7|NIn9lt-(heTJ}X? znNsey;l=a~PunjEG}<$vj4LxkEOn<6)|lwNsyI`vsR^*?ayFfZ6P>=#L}0czr13mS znKdPt-wEv2^Oem<4$kd;xokdi@Tqd^0f$yez!>%M?cq@Nav34D>M-$7jA*VZzrzK<3}>P))NfqhI-{;H&}k^R*uHlCjOx9zvA(^v zu~t7rUx`NP(%SY~^bB<`R(9wrcDik|<*v4tHdn51Zy6gK`Sik^qe9ZEa zk%~+zUL17f=;0gIOiUyUtLo~tCAGM?1WKbO7S-ZYYN>t||6X*uBVzjPVTBCf@NS{h0D~J}d{+I_RhUo955eB`7!J3)dFn6mU_T+gIAU68o3AMqW z+mH*8Bwg6wi=Z1?pELq~LKpT1O?v9hYT~AK5h7{ME0nTnBPQb{{~Cl)Q|_1{-OCX5 zVS(JTu3?|>V7KT@ctRfw;%?YJwu@TzIHsw;HmkS3+9;=YJdsT* z=-gvUWgWXHT`}N&{W!VC6ohocn<%C;Ih`5@LOt7Jcy^}Ho0@EBlXC-MEFilH1}#E80_Fb;Ie7OW|4=b__g7tF&<(47qOCUsNE4SM;v(4=(gI>w za{TPI-D{lSvXy)bN3^Y6!N*DU5$aIV!#G}zG6lTJiE800&c5B+R@ZLwu69Z>5bw^g zQZ;N!H#9+;8fcTcIqY={DkL4mwgFfDc4J{19c`>`L4#OD9i!+4Nz@{<5UQtXCqy&R zlYkBg`KfO>XR%7kgQgg~iUU(G+9L=d=?RKHoj!{1h?w@EffhKQKa`&o^~lF5@xD!-%=R{^GbRwDghvWq9b)tpiLLw*#D{@rW6KaF9M_yckXRYq4 zrVSyyEWIO>*Y%W8>-x-=3hC;|>o6VEm#;6c*NH$j*7d1tj9*5Q4Nl^FZVZ@75pcUP zcms+MkSo_x(cwI**EG&x0y4bd^1_!CKdAEbVFlfsJ|oEtWIuF0wat340YZQ&^dTR7Z-jz1>BAhceYP`&O(@gP%?vxPw55IRWV)y_IEMT!HD z0o5Ib*+Ml-bk4%hT?Jisr|-%HI%E`~3K=BIw9$zv4JW&qUJqjBscB2sWdjG=ci|kg zQLHQubcb}5n|s!_2iLbDU|JzK@sMPIfRQXb(;P?wRqW9-T->Ua6d2tKuiH2dmT~qe z4yR-sVQ&<5V?QMnbfrb=j2^gX&u-D%fS2aT(9mnz?!+cDeQG5yRiVgX2)S#^3+r3N zbiIduJb_K2vuEh6B&P-r+%#u`sE{0s`63qhGQ8>PMPkUy_{!{yryQ<8J_7KCMczdQ zF1>)Z)^AYqI{Q4RL=FDD%=31KUl-2HN~KarKMJP?Oy(gb5=rmrYO8LA%!VB2foPGs<5H=}jG>$!sm1Gu^WSX4wm$#Zk}(Kk*J( zD!szw%xf66Js>a9!Ll{V9bWdV)pvsH4)y_+sdui6aBt!zMDGaM={pE!`l>4jc8ekyHY*CIB9 zkO#wbr299x)wguK7+2B3^w61fiPES|wU9e9)P-A{;WOC?-T`2lIC>^MM>gUFxgUVT zqeH-(@goAcV_F7@8rTNPKQXX&fvRwTp9okxIg%Tyy_%ZX)L~q81*%vyF4K>Xsr`RG C=RpPl literal 32559 zcmb__dvK%Ibsqq(b|qR%lN7U-nYDZcdspB_SP?IhOUn{K09=3s@L>UPxzxinNnjTg zvE+v2N>*j1cIcbTI#-XDm|aNm{q}i zsg|u2^3`%s-B-z`GPTr9q37{Ts+v`i@v;8?5Vep-v065xg3$}%)Q#bY&v{p7BDQvB+v>v(MsJ9x= z#?B`mx&CZeZXRi^@7%b_MK9)Sv!&|!4@KgWW9Vzj)mLnK{KE8jB&b%m8>X{<)%e(r z?VU5z3KhfUN;+K3mKM}HhA_KOC@6OW=g*%Hs`|<#S=HJ@nS5nT`F_Rc^97QfyRPA{Z`F4f{b@aSaO)Sg=qky- z@1o09-zSp%cGXwEe!HI@@k_q?V=2hjRM2_DRlXoK2U9OJ2j$W!Fz5?KqA?|di$r3o zT+J?IETYj;sz@Xo?R|71p)mMtx@J|Ds7zU17*}bllup%v3Uf6PSH)~`MkV5^RLcQ3 zm9&+~s(4)0DhpUjy8T$fREWe?I)`Q=Ae>3{9Dw*duCOSkRB(MqZEo$V6?JWWSFN?S zHXA`Tl~BR+xPK_9CL=0{KZy$}6rWTRQ8h8HBGJT{ijAw_^FbAjtKf4W$W)yc_ym@ z|MJh>L^m5uCqqLgN`0Mo-_zu~*X9C`wg0t$d4Q|#&sYOop5LvF@Wa;mgInhoPY(^< zWexUq&NPQ_onDkT{CaJq$fduzI8q#aqZIf^`y2k{;l+`S=6Z8+^yCTZ`3u%?=ijWi zzheysmIvFfgY+%{0kulms;UT(NCcCusK`W2EtIN-R5h2csYqf<6~Y8B6^TVPjSzYn zlth5D`D`Hr1Vj$e<)nI|M3fm-Qw({)R!vSSV%#YSRG zR5Mm)NlggmQE04RFxo>%F%SXKhl|8$se7=G72%=~AUA!??+YZqQCszOhsFb`PV7#C zQv1QWf5_j*2uSkpJmYPh;XC|tzH=hi9DVGQxwEeX`Z|9;hb0`JZ~-hn?ww#{!Zj+) zAQpGcGCIX1%@YH)zOz}Opr&!ATxXJh$8$0y@H5Y-W?`sitxu>-77LSB`9)gnK*ubv zxSRu%`i=&k$LrO|@Jp#|+-Zm(P5*KZVLt$pMRT&(!n zx2#oqZLZTl4{CX3@Ai}PXJ6gBy@*ve1)g5Xmtt6SHouO5Vb9W%Tg;a-)*_hF1#sr_ z5e4**icyX>(1wakhe4swCH=wdFP&V^?xsZu%zs-B9=0-l^wm$Q{> z-YVfCGn=4VTiGP3vf5BmrTiK<>-+1YJuL*H82Tx$mVL4QGc z1j#g8v5H5NDrl5Q6%f1aLbS0=wverf?ru~v5GYahECIDwN;^+TV9cuM zQG6ld>+|``!k`(72e(dNN|Ly%h_w3_LpUiA)+!jYYK(^aj$P36k4_pIh76-uwp0VL zP8bHQVlfpYDoZh;vxdo~K|e;Ygk3YWl^lpZCLTTELt^MRAcp+O8V_{US94G4rKcg7 zm{~bLNr!DQNwrHXuSD74Im;!t$3I+Ggc#ooWajz0JKrnOZjnTbL=12uy1`pw*ji21P#kg{Sg-;WdRss zjdC-rU{q@cdQ@ugt&~oTXl5^n99s8TyPsQXrx(1tKN@ zI;VgGH>3axOu_*Hv}EcK>l1oe5Nr>u@Eqn~uitk#e9!v(na6LGg`aoyB&W(mC${b8 z%$QiPUPW?&SGFdPkt;wxkYXlK7AEkuWQt+D@qLE(U=qNl<-RZ@@{nW&BvlF~3G4;Y zg*De3>*t}crp03^qjyr3X%xgE(Bb?15CbkgGvxQ>zL?B;dV_$pdxKo|^g%-Cd7zAY zqBdpLWcxrDs9}24A$6R$SqQp~1<>sV%#mb{r&Vt~a_~p>*24$ithXLI`0Z|P={LTe z|J~$9p0yfGI=At?m)qY1ouPmCU|go5J!`k3VdDTa!hm3<+D1Vy<$QqP&jg<`lrO4Q z^5k(+twomt3P7-iUO=_IM1Db5Gl<N=*8gEZGG#NyXjMg_V^*u=(IZQ)majqFm=#YtSNVj`*LNq;k;6dUmcY=UFFADS zc)oLN4#q(KjpnEG{x|Z0SBeZJ{`tu3^PRg2&C$nSZU05#>}%~m_l00u8dVtDrfASA_zA#XE z%6!9kcF)_ze+&^r+EUYLz&%yUkjT~QApAX|^T8(r49c83AN*1XsFnCh+6!G64J4QR&Ey6a&7 z6i)+>`nWR2v*-UKZrmE+Cwu-c)mxc&RPUF)^;YYx;=%re%u2WR*#3KThjUtBa*vbV znxT3teXzewBfWzMK_i{jWm+egyFIp_Fhf5+xA6mhMl)+2O}1BkppMNjPKJIS$ta8icSIHJF*wPDSildNy3cYnn#bJhtm6lPl z3xvsX9`UUhy!R59$-q2-{ltbiuE!H9mC2w4ypvno>(|ydAJYDjo_jJcCZdp83!4_ut0NYWxIk{2{I$)k?S|TJTwht=T;IH=t|EfA^C;dVrXVC1 zN(fq57fX+!S4@PNEMAcV=b4plsxYnKmPtT%1!XFT+SD*Bs+3196ebhAqMljbZEoG9 zc*N$->#L3JAOsvl%w6~!Co2zbvqM$m0ADbDxN5(OkqL;pG57<523Wm4$3WXuC<-Gq zXrS0zC<=`sC}8b<1=o2$!Ej@9>zPgMg92b8Kwj|b%I->QTCH4PUB7m7>*kJH*}iu3 zdSi1}JrE>MT@e4KFg6mp4D@h#bLDy?ytBKqi_+n=3Wu+*Z`Q-?M%xKDSGMbLbODwV zaL8P5Y+q}HS66l#>go!IG_P*qCE%=k#>}M;!ZP*Ys-Z<@s$8yE6q-3Kvqwl~Cq=k0 zTe5Y0$Y-Kgz$3h9Rpy~=WVKe|eq;nSlt{0Ra4}nBEjl$mJ|3Z;sPxWOQZ+w4eQu#d zzEZ?Vu^!U3bF56xu*S%*(}irRv``MuT9sn;9F$F7V%by?mr*sdRAZlWOzq%4uFwNK zuCwHvM$lGVQ}8>8A5;03{KtL%3QOkCk-NorNrd-32m$=)QdM;l-Al}-FUkBnLzlR4 z=dOjz4kPc%!{*wZ-47o35Aus{`(OIVP5Q))wSWL#L_JZwj97L}foWE=JQNOh!yQZD zq@hU&72Z6$;czPWynT%&FKr=CsJ$;(#1!bGpf^0QnsJC~ehADl0W(=p;79^4#8n79 zW6C!G)5Iq}jY}+>*jJ>|g=zT1s>F{HYC1I|0i7dyczYazF)=F0>#7G(R`7GOf;NL+ z=<9-N#vmC8N27a!F$>ksN~gr(H>;+&@hRZ>f*leDVXzO90EiiW>-Zf$|7FG{|L`ok zuq`%*?(bs?&oka0zhyOt_tzE&IwzdMJy)WQtq%q6;1^60{39{JqO=WC7;gX4W%XF+ zj`j9G&yBu3H-GT;_4YUO8{d1S{rSb=7n;A${VtAh#}Zy_t_?B`!Bq#oZfGWgRV@OI z+;#>l#6(O9#EOZG4xv3tv16;8Eh)qnJhBfW+95+Am;{-im}0<3HWpKmlGAxhL3B@x z`v!DJVd3dgb}?+MdJJ|tKO4?o0l8Nd==r&lMIIf5VF@QNs|r|;S;RwTg%YeXiK9py zYz_U2D~LF)@%!VsW~Q2Pxu+R-2%DC?(Dc;LN7K?I(IgQqA~B%G9nfdYrY)ZXPfenrp{3q(RvR zy3lpsW;wkjp_4k{rRQEKXqiaN+NNoq$Irm0-EDj58Vl3V^;=MH3e+3;`RS8lRa%h1 zX0Ra$6_^OeJwBlTIC77sQ701WkSItEq^oHWfr6u&j52!>di0Q^NHUM=Eg&NCld*^w z;euSYUj00rXJM;+7QB!Ck+`K`lXxfq>RT{c3Jz^_hd+WL`_n_i6ZS-Hnb)iuw)YL>AD|#H+ zc{D~1WhjXT#PG;g3d}FH+npRm;zH4^&~cFX$-yrKW559uM>v+PYr-1AKNtkADXi3y zNhc#~;O&Sl_<|c} zFi$jF)!sOd8`+GUBCOE%@k54#J%!fRH5HEF#f|O8?(VZ6J`;qFe|=?l`plWN%o)s8 z=9SK6)AOWd9#-SuPinkOqH}`(@(<5}$&TSF8ohz5y~@n!C|Lg?&JnwDv(=I@>JYmD z_FA*Cwn4U=9+HP3X;={Y%6A&05hpK?LI%JvGJ9DcH=7C5GmM|pahSwDW>ML+E3_k!b-NfP@w#kaRdl5@R-0#i?`iNF~NcFqbRYgEJ1$t-~D!!7_TTfc|%!%e+Vee?@Bnhr4<^rqiB zR4xp-xD+mBuhi^(5%Hu)$RJ(VL^5n+jS^gCmG0bZ?GjA^Su3sW#!CHJq|2`F?C#(p zl-=M1%KI4kv81XR37RrohivCMOzVC%g<9(7CL7CY0)zs4n;2Ua4h9fvogDb^F*Ker zRq-B{7IO`oki)CA8nG_ny^v)lyaLuGFEh$_5|#$iiHk0XtC$i~bupK%klFE71jzio z*`Y6e2;qNc3A7*JNIyTA*G^i-b8iU$FXo01H5KtT^*(OOw9?za59fwqwCFS^v*sem z0ut93EafNQ6M$xptZ6Jjh*P7#o~~3ir=~q!22N<w&KNMbV|4bw$hU%2{S;W`tW~0Ph~kii|BZJ*KgKtEci__hw>YIQ6cAb3pqq=N=SEt${C5nQF$d!lYL9}FsgIQxi z>+w(lu)oY~iL#>81!zcCu?$Zx)*>f`HFmH-KYpx_3f7j&*$;di^@Tj_WPH7*;jSvA zX0jAE0@SJtl*3Hw6t8jIQqBu(S`rpz={Sz8No4qE5B;?w+O`Bax-X$>>IeZ@M(W%%Zk)+sK-%}Lc^)5fr$wJHMm@*rX(op)P<&C%t7 zH;aKM_ijIJ4W3;d=(hh4IUsEQj*Sikf2)$em@jdfqGtRN=wwXDw2JjJXsyOUMQoQ@ z3+URxA5_5td#tM3aahJK2t2&BfJD+Na1(*oKEq%ow*dSgL8U%`HBK&M;>zUFRH6Fz z%GKR5xKhE|)gy*Wd)hLr8d-{*fIg|PhXl#^=oc3V41$T{0@^gOa6|`L_~%RM!UCM= zGy=gf_z*ekfaN~{NQHHa9zXQSJ9B-Mrs{v4;VkK>Pkw#R_iJ)r-1t5t?IZg)u$y}okXPxd9-AE^5u zm$VQj6JF(`JvrRSTH;a3|7f2x(CYT*i=BPD1x;*S(K2`Etr`l82!2W4m;qBce=jFXrqS51d}IR!C@fE z2^j>1X|P`o@k6^RrLzhFs>2WAz;ZDgP6&W@Y4b18V^sSd1OdGy7J;f_G-tRr5m2Zp z2qJj|4!Np8DAIJ9>)TpA)~4z;#g@G zvb3M;txrTkNJk>_!=f|k4d7dNfSj@tGJU=J%<3^xL+z{+9s(t`@i2z`+Av`Zbo!p! z`2NsPUoMHfgXTwRu#$84(l0UtOU^Mrd%SZpIhX(bJl_mnzx}<}+CM_TgI0qCk;xOe zP@X+ch5(Ha`-e1pfGwe~utmyb=?MU6==oH^2nM$q3HTzBX94P|D>sl_7TBHy&qyqa zeMyiM#xKQf~s3KopUHO+vnGrVI45c*1~y z5z27j*$-8Y=b0kjgiITlb2!Z)60VArgZ)v|)a3BRB9gA|=Aao$u5P0L208~An4FOVbqIia%*|ep#ciA0A7q;Aj`!ah%~@}Vn>>@bivC+ zvVlmHh$?NB3QOKq^M`EirI3dA%r>ps589sa|7ZxT7rcIr? zmoMQ@>cPEBFE#I#DAA*2Y9H~GABx&(+lwF#SH|}mTn2DaKC`vGvAf+sFr1^{q}~L} z+YPve$X99JlI{pqgLFt(2W&u^SBf2l00KD=;6y-n`r-HC@U@$bogKKC*gcAH2DBJs zS|J^Rw^UN5+}h3UZHn}-vH=2f483}GTk01=uS9>BvrahOC>^eZH9`=pJ0^1dC}>kV z7Q{~V#xj_MTv=s0?$kpv(8UBN(C;;Rd#rZY**3X&sKafz8uQwq2wo%?h6q?sAHon^ z^~Qw*Y+wbG3&2K(uA?)D)MB)$YIfDz_Wv0xuh|>A*K~)_X1`za)^c{4c3_K z_yR!zYNRUrB_%HD-o+qN9qO0yYa7&(M~qgH>alLxypvIIF?n~qo8R-_O{(&- zf?wPx2m9~oCKm^13IRVi%w6pHerVo4*u|UIbA_}J_c}N9TYJ7gO%`U{kM?|frpg0c z#eUB%cI_5)2cOcV|IpN`qt?*S@nkXJpTU35VBky$_*?aZ{f9~n-E>i2@{P#Of?sw_ zx5W1|H~Luno?OvyO3I+``JAMdE{c=G*bhJc-!thsvU?%+;xHj~)}e%6OmcvV!)>XV zR}ArL9j--U7!(uQl8NwM42G0}0uLR0=2NhZ757zN06?jABQJny0q zn&ut6quzH&NHg!?Y4yHy0!UHKf$jdHj(0tBL8PSpF5)=!BNW<~VUfGW+3Y~>67vF# z*7X9ZnQ|@xZ?nMmLtPA7Jcr5jp6+uBaR3^w7TIi3>41RID`5PaK0K}-Bi@e|7oix3 zCM2g3qmleT0S2u*h}v2>y~@@Gvnj@K3rYH30V)=ljz(iO2QIC>4|n}ySWxD^CUyLW%^`oF*2z{oADAO<<@<6n z5D3f#{Bu~C%&iXgpJXo6ew_bQ{nvkNG|T8Ky}R*jC{i{a2v?j;+T9aDNmQWlU|oe?ZOM+K!V(OQf~#@#RA1Tf+i z@|X2h*$)k(fN#7)v=O09OW>O@j6aBe@gKQ^2^mx${xFdPQ2imC-U8{)e<9j~>fx}~ zLwfOSY>SwKIKp=cVy}X8CK&0!pop(@20q9I@-XVmp`ReQpwdu~UavP@6Y^>dTT1(q z0k#c{~qS=Drlp z`}5j~%ml_4>xa*SP%WWX^j({u{m}hY=UoztCPJ1xmZEqlgY*5AelW4kwp@S7v4^)*_|I zM-fgm%nSTmm!ShPbh-s`k8}o$6a0htJFj*imJe$oL{qTLlto6dVeP$25Nrxv3e+e$ z8juP45hRg3f|ph~to~0T2XJq9z!EYaIX}Gx7*dM}ggQkDNPyj#gR}yfifK>T_p| z6Za2211k=taURnOlFO@&#u%&stUAdqref}SPQY)%!aEPiGMm3*$aIMwl2q%qNGU!`5kd+JDWzth&~Ho%`;YUpv>;GsuB~etpk>l9}e7zrXMIt^1Zg z*lqp;>pnmJTK5H(?-QWsxnJvp@<$!w-^;;ndjFKAtRR;_jB`|UhIP*~?ubk9Ri1x! ztD4R8qn>hHLmK9({~lj|LL`G2@m<{tzX#4N)qZc?kMQY{F#2zRQMa43^hCb*GQuCr zr}uvR1MZl_2e~gNi~vYL+16qq0e!%c7qquUD;#ks`RR--s5lIMT|SPyJS|3I*jb`E ze9TU#;f(+>gc)>s5>!U%iK3LFqes~SKO}H)upKQu%}R)I8dhW;Ax>c=64Yc!FSefP zgc(}0ZlM7_G^J+dt4r0H1*~=OFjEl%K;(`|0P$4Q$CX4V-$sgI7OsPuAQZIJg2E$d zA|hkN-Rj!vgaNv^G`6q+s5s%}3^XrrY;Yp@^%7{#aQy@rs-9;8p*SPY5{N;|bp+nV zgsV+TQ6~-$D{FJTMN%q3QDZvX42DDqs-W~2enf>be1yaqg=>No1R~`P%$CN+u&D_q zfXRGIz(@>zTuO7I%ERH0_te0yC(43GFTi5R$W`5{zD27rQ-j54Rk1;54#Km8Jzt)C zfYozP4k9Ba^>BWQWT@Tbtp_??vN0r^Xtg$;qW?S zp;MdXFwO^r)=UXHUa^VELatwfD^~0$wX?Rpeq(n>?QGrLCWWN64&UeYvlQu-;}oGD zpe08X_bA)Oqh-rjI$(+%IV?T=M2^pzM`co|n#4cS`s zm^5|r0u;++dzmNj-dPKkG@q`gm3rB4X9|pqQ7X42MKef|vBj_`QEN;%=dZ}j;?iz-U~pj zdl?1-(NPyfJugmoEdV+#~jO(4qYnM(rv*F6_v{dz9KMR1ZT>)#15Dl^&yvTTg% z0I}*GZ5+ohnPPE_#1z9wJjEbG^?2hja%7OChR`76F#7Zpa3EbQ2FA{@h!}b>&%o2A zU<~jx4-w8Wm(Y&%d&nJXItJ89E5Mm4WkWIQK#_LX>i1C_ict+kvP3zJEQ(gNKQ;;< z522i#u=*%UGR|=vu)~eP?OiyJI5?-IF*kU~t7M=UaeS>2%)(O)u0Ea(os*?UOWD&h zXUcKY4>1`Ml5BDVgdh?)&T$I`o8ZLP0S`J+5+nnuzC2exoP73jDN!8 zJNWJ9p6?4qx!#v^lUa7@qV12B{Cw{` z6yaZ%6~+2XXHoi=LUFP3srcth->?Q=8scL7gJ;dr*XMt~KoIf2$N+f13$R=$=jSGo z+FG{;k%~Mo0WX+@b!&L!Shqe$S;%uEA2b=rN2emgs;*ljBmG^TpN1WP`|WPYFYZwu z#Gs%}HU&xOPJ2%Wy;vfX`}RfGV1H}x_LLjv@DgZXYvY^iJ22v__6MZQOZV~ZQAHR? zI4k5ondYEU445H*)IHqhpeZt<~{^9qq>O75;{fTg!tZ+I}g}Y2ZPT^@02cIK5 zkWM~NjFT4+Lpq;&?Z z3?C)@nF~0o25tfRHUKAYCE$>xzzL&8BtR9hO9CRd9Y=^)!y6{&;q3!))OYp|#3*A? ze6=x9g=Yf+Ea$kow15*T;9#HBS9I()>#GrXL}-R&M6&B#G!_N2J~TYI{ps0!c4@{+ zRWg+Q;hrBfH)spRdAm*HrFTQ7Gsk25IdI`icSqcJKUvvbBz?3Rocu zA@ImvNdbP?j71w7g4vI)TwmX87%|3VHA)wt9D-N_e$$u|reozn?3qjoFW6JkDh5Hbqt6>)j zBs%|G*$>$VQHr(s>I^gE2bR7f{#wb;eN`&iwN9tZ@s(2RHB$?To}Iqre5a3MZW20^ zq~6!se}&L2EeYY5FcXZA5}GJhhJ;!vrec^B77U1)5-UiNHYGrxAU5NrLrhmwG0`n; z^&meS^m99P*LJyy@5o?FZjj$FHpTgpE;)NKT* zE@Z9Yn0KrV_W&XY{q_t1^0{}ykbb6PFj_rbWC$MWNc+!Y;DYXMuxjYYuO&!i9Cm{k z9JX6&m-P%BnV8uGUecyc3fm$ukk8=j8CYoJs@Gc$+%3_GASGIUrX14iY!5iCP}+eJ zRCL@|ltQN3;Z5FjZRn9Zn8buWyj=%Q>BAFJEkZkfbT#r9_mqQ#3oc;)_5->IP2vH3 z90#Ymuhd~TLO@D85XYt&NF>ONx2`qTZ=YadCqV)ae6~0E>RH%TIwzY~WzUbZyg=;~ zcF@UQNG>tl4g3!&9%as(BIVWn?G*r;aL%3K#0A;=OygA_!hZnantdVx#0?$f>B<-4 zlruilU1Gi=vF0KUhje}dV=g{+PU+laE2Z}kdDY`j{P?{r- zYRsX8B{d~K`L)aX6Fu{GmOJdEUzvY3-|0ub-_px_w|{x=EIzuh0m%fy)ls+z)C8oW zlO7mm5Yb0V%t0-*DkaI;QI^4>bX9O4eFfsqTCS4+8q0gxBEq5FS6+qI#?Z{u&K}ZEl1IIVWxowhcbP)?^ zP4{so2%QaT)3xR_g}k`mO`OAebqkx?K|y%M$Hy2w#33TrxiOfP`;aff_Rny5j3!Xy zMTzoxNN_Jgu<8y-vnfy_Hsuo-8YAIMOP%C0=n#E>r4JjbnIuF4f_B7)HMf84dP$q! z1|=InUX#+Zk<;neNjW{02~&>$W@<&H_P@J_TVcZD9~Q$nMM-v;IqO_v(4r}s^S0>A z9OjrBatzu81cuKG+JQ69R)KEK$7(t5Xej-*%A+7&^rjamoz7zyx!I;2XhoACh)b@B zqF@KFWH1(h5Eo9}d*NS5 z4tmba*GiEu!__HsN36)cq*hZnkSgT8KlJf z%I2``>4Ptp&0*W0D0lAW88ID^Y%m*cpa?iPwvS|`FLRkeLssK^c6xK0-U+hPAi#$3 z1vRKOWO+cVs1c^|nKj(fPUuQGb?K7pkqU**sSiPpR2#cEohLYkZ?Zwbt*Q{h_XR5j zmXC~g+U>jmZp7YlvNx(G3y8md)lYpPU)A*xOpPDu5QVvA)5}Q_Mh1^`-%sbX+4~6C zKWj8T3dF2!wOT7TAk%TshEr<&Du1Hk#`f0J>+tu|*a;$+>5%@Ar@fGtvoOotXUH2P zjlKzi%J}SCXrYw9LYdjw(q%q7&h8DZ+t(;7mLQ31`-Z9_reDKB5h~;!JsLG~{_VP_ zL%2h7w36w=)e>5F-=Q1Na9!`-ezf>dp$yg;D=Qy*X2l}jhUlCnnYH^J9*)sl53s#S zTe_7{_DUH$_NwQJcULkXDfvBL0C{j5e3H}QFRGczhgw@J^_w?#)QuH7X=O+4UcUjc zwYj^qg%5PpS+A_qm*#fxv)hVtn;2hjYFR%<4BX@Y{MkI7jRBYEhNQ2jlotZ_9hE~t z^Zi1jn`v?m5-rNQDj+KX=g&0Oj5OY%cbGouX;pRY`kGo@UBgawDzK_nAGK@RZS)6c z;R(TOYysQ3v4wMJFn@YWy#un~6c|ob)2F$^Q1zuQDUK@R3L_x7&8DM2O{1$CP)UQt zKJ*o&iyZXN7Ys?hBCS)`b)S^)`6vU8zEN(Fr>4tcn*=)wGc~XhoPY`mG#<>dRK4N}?VrRHB`gjn79O}Y8 zOp9(ju48)OK0(Sgb}(Rit0!XiJkTTeNh^F`(O>`M8~3>v?iTFx2QcV<88y;xkT-)* zTs1t9#s1=+&B)ZSz3aHlt@iAN_LQI#2LPCU5-JX47WH;YPhXxeCN^xouYYFtYxd!vP**gW;7$!uW z*vaVn(NUtj-{Gf5yLglaWs6Ga5!%FkJJIJ6W$q>b0J}LN-=8dcS;KkMEhkAzzSBXx zt^BpwqzDSnpbeMAtDZ3*F=Si*icaQ?*ez*E3Y+&fNZbYR&{N`PlESVYOno={jV%A^ zMX|f#o?LJG9F;>mHo6YUVoxbA2<$sTMSlp<7qcozsD`wJIxoq1E=^Nd1nCmkSG|Ly z(t`H+I{%+()MTa>-=%sQ0ox~rHrbx>J)je6edRFRM_g}e~cZoP4%u~{eJ;DgvQ zz+gY1;|7kj2oZPmguJ*U#V90FS&GZSKS$xyQ_7%A4^c+^An)dUIz^w5h|dqgBC5`kRA!SnTqKbcd+Vlwpj_9GkrNZq=TcC8N8B}9^%7^ z>>79u56~rrc7bGbhbCDo&Ck*cWQ>+n|Iu*5Yu&JCHlUkq0iVn}x)MKiYYS}OFqPVe zlx0ZSl_AT7(PXd;@ZcO)1`kUgDd6pzCjxETv+hWN)l`ahS)%ouLlT+z1fJ(r4c`t} z+1#PE`_)HXpr^6ARZT}m KxRefdB>#V|8Y}t$ diff --git a/lispusers/GITFNS.TEDIT b/lispusers/GITFNS.TEDIT index 54e04ff9..b09d9acc 100644 --- a/lispusers/GITFNS.TEDIT +++ b/lispusers/GITFNS.TEDIT @@ -3,50 +3,90 @@ Medley GITFNS2 1 GITFNS 1 4 - By Ron Kaplan This document was created in January 2022. GITFNS provides a Medley-oriented interface for comparing the files in two different branches of a git repository. This makes it easier to understand what functions or other definitions have changed in a Lisp source file, or what text has changed in a Tedit file. This may be particularly helpful in evaluating the changes in a pull request. + By Ron Kaplan This document was last edited in May 2022. GITFNS provides a Medley-oriented interface for comparing the files in two different branches of a git repository. This makes it easier to understand what functions or other definitions have changed in a Lisp source file, or what text has changed in a Tedit file. This may be particularly helpful in evaluating the changes in a pull request. Separately, GITFNS also provides tools and conventions for bridging between git's file-oriented style of development and version control and Medley's residential development style with its own version control conventions. GITFNS allows for intelligent comparisons between Lisp source files,Tedit files, and text files in a local git clone and a local Medley-style working directory, and for migrating files to and from the git clone and the working directory. -Comparing directories and files in different git branches -In its simplest application, GITFNS is just an off-to-the-side add-on to whatever work practices the user has developed with respect to a local git clone. Its only advantage is to allow for more interpretable git-branch comparisons, especially for PR's. This is enabled once GITFNS is made aware of the local-machine location of the cloned repository. The default assumption is that the variable MEDLEYDIR holds the path to the top-level of the local clone. That becomes the path-prefix for the pseudohost {GIT} (see lispusers/PSEUDOHOSTS). {GIT} is then used as the default handle for local/ and origin/ branch comparisons. Just for clarity (and for compatibility with the additional capabilities described below), the variable GITMEDLEYHOST is set to MEDLEYDIR, and GITMEDLEYHOST is set to {GIT}. {GIT} defaults to a pseudohost on the {UNIX} file device, so it provides a git-like case-sensitive unversioned file system. -The main use-case is the Lisp-oriented file comparisons for pull-request approval. These comparisons are provided by the prc ("pull request compare") Medley executive command: -prc (branch) (DRAFT) [command] -This compares the files in branch against the files in origin/master. Thus, suppose that a pull request has been issued on github for a particular branch, say branch rmk15. Then - prc rmk15 +Git projects: Connecting git clones to GITFNS capabilities +The GITFNS capabilities operate on pre-existing clones of remote git repositories that have been installed at the end of some path on the local disk. The path to a clone can be used to create a "git project" for that clone: +(GIT-MAKE-PROJECT PROJECTNAME PROJECTPATH WORKINGPATH EXCLUSIONS + DEFAULTSUBDIRS) [function] +where + PROJECTNAME is the name of the project (e.g. MEDLEY, NOTECARDS, LOOPS...) + PROJECTPATH is the local path to the clone + (e.g. {dsk}...>git-medley) + WORKINGPATH is optionally the local path to a corresponding Medley-residential working directory (e.g. {dsk}...>my-medley>) +When the project has a WORKINGPATH: + EXCLUSIONS is a list of files and directories to be excluded from comparisons (beyond what its .GITIGNORE specifies) + DEFAULTSUBDIRS is a list of subdirectories to be use in working-path comparisons when directories are not otherwise specified. + +For convenience, if PROJECTPATH is NIL or T (and not a path), then a squence of probes based on PROJECTNAME attempts to find a clone directory (with a .git subdirectory): + (UNIX-GETENV PROJECTNAME) + (UNIX-GETENV (CONCAT PROJECTNAME 'DIR) + (CONCAT MEDLEYDIR "../git-" PROJECTNAME) + (a sister of MEDLEYDIR named git-PROJECTNAME, e.g. git-notecards) +Thus: +If MEDLEYDIR is defined, + (GIT-MAKE-PROJECT 'MEDLEY) will make the MEDLEY project +If NOTECARDS is defined + (GIT-MAKE-PROJECT 'NOTECARDS) will make the NOTECARDS project +If NOTECARDS is not defined but the clone >git-notecards> is a sister of MEDLEYDIR, then the NOTECARDS project will still be created. +If a clone is discovered and a project is created, the value of GIT-MAKE-PROJECT is PROJECTNAME. Otherwise, NIL will be returned if PROJECTPATH is T, and PROJECTPATH=NIL will result in an error. + +When GITFNS is loaded, GIT-MAKE-PROJECT is called for MEDLEY, NOTECARDS, and LOOPS, with PROJECTPATH=T. Thus, those projects will be created automatically, if MEDLEYDIR is defined and the relevant directories exist in their expected relative positions. +When they are created, GIT-PROJECTS are registered by name on the a-list GIT-PROJECTS, and they are otherwise referenced by their names. +The variable GIT-DEFAULT-PROJECT, initially MEDLEY, contains the project name used by the commands below when the optional projectname argument is not provided. +GIT-MAKE-PROJECT also creates a pseudohost {Gprojectname} whose path prefix is the prefix for the project's clone. If WORKINGPATH is provided, then a second pseudohost {Wprojectname} points to the working files for the project. +GITFNS also defines two directory-connecting commands for conveniently connecting to the git and working pseudohosts of a project: +cdg (projectname) (subdir) [command] +cdw (projectname) (subdir) [command +For example, cdg notecards library connects to {GNOTECARDS}/library/. + +Comparing directories and files in different git branches +In its simplest application, GITFNS is just an off-to-the-side add-on to whatever work practices the user has developed with respect to a locally installed git project. Its only advantage is to allow for more interpretable git-branch comparisons, especially for pull-request approval. These comparisons are provided by the prc ("pull request compare") Medley executive command: +prc (branch) (DRAFT) (projectname) [command] +This compares the files in branch against the files in the main branch of the project (origin/master or origin/main). Thus, suppose that a pull request has been issued on github for a particular branch, say branch rmk15 of the default project. Then + prc rmk15 brings up a lispusers/COMPAREDIRECTORIES browser for the files that currently differ between origin/rmk15 and origin/master. If the selected files are Lisp source files, the Compare item on the file browser menu will show the differences in a lispusers/COMPARESOURCES browser. The differences for other file types will be shown in a lispusers/COMPARETEXT browser. If branch is not specified and the shell command gh is available, then a menu of open pull-request branches will be provided. If gh is not available, the menu will offer all known branches. If the optional DRAFT is provided, then the menu will include draft PR's as well as open ones. -Note that the comparison that this provides is essentially read-only: any comments, approvals, or merges of the branch must be specified using the normal Medley-external git interfaces and commands. +If one PR, say rmk15, contains all the commits of another (rmk14), then the menu will indicate this by + rmk15 > rmk14 +Note that the prc comparison is read-only: any comments, approvals, or merges of the branch must be specified using the normal Medley-external git interfaces and commands. prc is the special case of the more general bbc command ("branch-branch compare) for comparing the files in any two branches: -bbc branch1 branch2 [command] +bbc branch1 branch2 (project) [command] 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. 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. +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. The command cob ("check out branch") checks out a specified branch: -cob branch [command] -This checks out branch and then executes git pull. The branch parameter may also be a local branch, T (= my current branch), or NEW/NEXT (= my next branch). My current branch is a the branch named nnn, e.g. rmk15. The initials are the value of INITIALS as used for SEDIT time stamps, and nnn is the largest of the integers of all of the branches beginning with those initials. If branch is NEW or NEXT, then a new initialed branch is created and becomes the user's current branch. Its number is one greater than the largest number of previous initialed branches. +cob branch (project) [command] +This checks out branch of project and then executes git pull. The branch parameter may also be a local branch, T (= my current branch), or NEW/NEXT (= my next branch). My current branch is a the branch named nnn, e.g. rmk15. The initials are the value of INITIALS as used for SEDIT time stamps, and nnn is the largest of the integers of all of the branches beginning with those initials. If branch is NEW or NEXT, then a new initialed branch is created and becomes the user's current branch. Its number is one greater than the largest number of previous initialed branches. If branch is not provided, a menu of locally available branches pops up. The currently checked out branch is obtained by the b? command: -b? [command] +b? (project) [command] Correlating git source control with separate Medley development -It is generally unsafe to do Medley development by operating with files in the local clone repository. Medley provides a residential development environment that integrates tightly with the local file system. It is important to have consistent access to the source files of the currently running system, especially for files whose contents have been only partially loaded. A git pull or a branch switch that introduces new versions of some files or removes old files altogether can lead to unpredictable disconnects that are hard to recover from. This is true also because development can go on in the same Medley memory image for days if not weeks, so it is important to have explicit control of any file version changes. -GITFNS mitigates the danger by conventions that separate the files in the git clone from the files in the working Medley development directory. The Medley development source tree is referred to as "My Medley" as opposed to the source-tree of the locally checked out branch of the repository ("Git Medley"). My Medley resides at a path provided by the Unix variable MYMEDLEYDIR, obtained by (UNIX-GETENV "MYMEDLEYDIR"), and (UNIX-GETENV "GITMEDLEYDIR") gives the location of the git clone . (If MYMEDLEYDIR is not defined, then my Medley source tree is assumed to exist at MEDLEYDIR.) MYMEDLEYDIR is the path-prefix for a pseudohost {MM} and GITMEDLEYDIR is the prefix for {GIT}. These pseudohosts are the respective values of the variables MYMEDLEYHOST and GITMEDLEYHOST. {MM} defaults to a pseudohost on the case insensitive, versioned {DSK} file device, {GIT} defaults to {UNIX}. -The Medley variables for directory search paths (DIRECTORIES, LISPUSERSDIRECTORIES, FONTDIRECTORIES, etc.) all have MEDLEYDIR as a prefix, and the development environment makes no reference to GITMEDLEYDIR. Any back and forth transfer of information between the git clone and Medley development must be done by explicit synchronization actions. Crucially, Medley-updated files do not appear in the clone directories and new clone files do not move to the Medley directories without user intervention. -The files in My Medley and Git Medley can be compared with the gmc ("git-my-medley compare") command: -gmc subdirectories [command] -This produces a browser for all the files in the corresponding Medley subdirectories that differ from the files in the currently checked out branch of the git clone. If subdirectories is omitted, it defaults to sources library lispusers. If it is ALL, then files in all My Medley subdirectories are examined. -In addition to the commands for comparing and viewing files, the menu for this browser also has commands for copying files from the git clone {GIT} to My Medley and deleting files from {MM}. If the master branch is current, then the menu has no commands to change the files in the clone. The browser will show those files that have been updated from a recent merge, and they can individually be copied to new My Medley versions in order to realign the two source trees. If the comparison is with a different branch, say the user's current staging branch, copying files from My Medley to git or deleting git files will set git up for future commits. -Note that the menu item for deleting My Medley files will cause all version to be removed, not just the latest one, to avoid the possibility that an earlier one is revealed. Deletion for My Medley files is also accomplished by renaming to a {MM} subdirectory so that they can be recovered if a deletion is in error. Files in the git-clone are removed from the file system immediately, since git provides its own recovery mechanism for those files. +It is generally unsafe to do Medley development by operating with files in a local clone repository. Medley provides a residential development environment that integrates tightly with the local file system. It is important to have consistent access to the source files of the currently running system, especially for files whose contents have been only partially loaded. A git pull or a branch switch that introduces new versions of some files or removes old files altogether can lead to unpredictable disconnects that are hard to recover from. This is true also because development can go on in the same Medley memory image for days if not weeks, so it is important to have explicit control of any file version changes. +GITFNS mitigates the danger by conventions that separate the files in the git clone from the files in the working Medley development directory. The location of the Medley development source tree for a project is given by the WORKINGPATH argument to GIT-MAKE-PROJECT. If WORKINGPATH is T or NIL and there exists a directory >MY-projectname> as a sister to the clone, then that is taken to be the WORKINGPATH and thus the prefix for a pseudohost {Wprojectname}. +When Medley development is carried out in the WORKINGPATH, the variable MEDLEYDIR should point initially to the working directory, and the directory search paths (DIRECTORIES, LISPUSERSDIRECTORIES, FONTDIRECTORIES, etc.) all have MEDLEYDIR as a prefix. In that case, the clone for the project, if PROJECTPATH doesn't specify it explicitly, should be located at the >git-medley> sister directory of MEDLEYDIR. +Any back and forth transfer of information between the git clone and Medley development must be done by explicit synchronization actions. Crucially, Medley-updated files do not appear in the clone directories and new clone files do not move to the Medley directories without user intervention. +The files in Medley working tree and the git clone of a project can be compared with the gmc ("git-my-compare") command: +gmc subdirectories (project) [command] +This produces a browser for all the files in the corresponding WORKINGPATH subdirectories that differ from the files in the currently checked out branch of the git clone. If subdirectories is omitted, it defaults to the DEFAULTSUBDIRS or the project. If it is ALL, then files in all subdirectoriesthat are not found in the project's EXCLUSIONS are compared. +In addition to the commands for comparing and viewing files, the menu for this browser also has commands for copying files from the git clone {Gprojectname} to {Wprojectname} and deleting files from {Wprojectname}. +If master/main branch is the current branch then the menu has no commands to change the clone directory. The browser will show those files that have been updated from a recent merge, and they can individually be copied from the git branch to realign the two source trees with incremented Medley version numbers. If the comparison is with a different branch, say the user's current staging branch, copying files from the working Medley to to the git clone or deleting git files will set git up for future commits. +Note that the menu item for deleting Medley files will cause all version to be removed, not just the latest one, to avoid the possibility that an earlier one is revealed. Deletion for Medley files is also accomplished by renaming to a {Wprojectname} subdirectory so that they can be recovered if a deletion is in error. Files in the git-clone are removed from the file system immediately, since git provides its own recovery mechanism for those files. GITFNS does not (yet?) include functions for commits, pushes, or merges for updating the remote repository. Those have to be done outside of Medley through the usual github interfaces, as guided by the information provided by the comparisons. -(LIST ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC) STARTINGPAGE# 1) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL)))))4È È4ÈÈ.È.ŠŠ8.ŠŠ8JÈÈ PAGEHEADING RUNNINGHEADMODERN +(LIST ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC) STARTINGPAGE# 1) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))))) .È4 ÈÈ4 ÈÈ4ÈÈ4ÈÈ4ÈÈ4ÈÈ4È È4ÈÈ.È.ŠŠ8.ŠŠ8JÈÈ PAGEHEADING RUNNINGHEADMODERN TIMESROMAN$TERMINALMODERN MODERN MODERN MODERN - HRULE.GETFN HRULE.GETFNMODERN - HRULE.GETFNMODERN - HRULE.GETFNMODERN  HRULE.GETFNMODERN ,R Íè9l f¸     !Pz4& c 5  3>B -ÇJÇ)O(  <wD$(?! x ¤I@?Öv + C  % ?  =0: - D *Y  « . Ž&d -T ñ¾ à!ñúzº \ No newline at end of file +  HRULE.GETFN  HRULE.GETFNMODERN +  HRULE.GETFNMODERN +   HRULE.GETFNMODERN   HRULE.GETFNMODERN  + ,  R Íè  ; âB1 L-.…$w a       / 27#h ã  ß  k  ƒ  Ç ƒ ( 'G  !    =c    5  3>B  + Ç,  I   À  )1          <’  &    $(?! x †  I  ""  ¶  ª D ¯: +Z D +Ù D (. (  ª1   D  ‡ J f +? D  õz D  œ+EXzº \ No newline at end of file diff --git a/lispusers/SetStringLength.Tedit b/lispusers/SetStringLength.Tedit deleted file mode 100644 index 61ddbd36f6940ee1e6c4a7bc62c45731355958e8..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 5450 zcmeHJU324D5mhqTWrm;vwkY6%hu-idSA~#xGMUU)QH3W_64lsJ)|O`+C>~__Iu^*1 z(Z@L6pRkX-@=M?s>?_aw8BX7;4_leZ?7l2T6|S;nwfgowefo4?jm*9?dNMHGf!nw2 z%dTl(x>tHz*N=7mNY|SWV8Vl!tIvq~aYV1YMd(FjsO!PP`~65H@!f$R&s(}X3sRcI zem)mbMxmExBql*7CWMuapT%R5Q2TJ7j$WKT*Dc%aJLkhQ*K+LUwuC?)`EeKuKMSxr zp3*dr~KQEO;wWO^U=V=zPm`F@Q)cK@n0)M3yI! zn80oUAI)n1=6;OJ7B%m#nKzZ9m!6( zkuH85fdU>DU|RX41O-B3D|U!}osk!E`!J#h1+Y(EA)3MPrOLWUf;Ca>-_V9`G%8M1 z@MW8CFeEpK?!^<;5`{}y+8|3Ij_4M09Se*^G>uxl&xEAG7=kFv&#jX~ZWt`gUQOLN zjQzhb30~QU(o$p~Fk5^nv9-oF#yLh_7~IY>>@bhPIQ#-X;J)OM*P@CE=2U@V1%{}x z^pL7sB;sul=NKAtpcc7c=ht4C3-&MA)Qw(eWc51Tf`G!lK~iV(XKpmkvk0f0(FxU< zR*lClbMG#g=W{uXOR~6=tDP$+Ol-yRfkdH#s$;CI*#-_E-SAQ4fV0Mo$me_}LC_Wd z#oR6uTgEwhUN$~>YhMonexnKz&?fwYlBY$wS64`<77!QNS__2ah|Lvwdalf z$=-pEiAuy;|Ge6mj83=foD~^AZM6!gdXL)mh*Y4KUgj2IY}RS<)nf{N68s>4Gm zqD$+@%K&m#4N0e^Q2ZD#6zKx*7mzX^nvm2Sx)*$GtKrC}EZeOJjS&Xvq7)t6V&BW~ zHXuWL7`nHZe*D7KXx;`0ywgo_X!9FaFjcQ=g^tVNZrCh&~S~w$&x$!s%L$WnVaCbo!l_)){88+v&S__hzS`(@~3zLpr3Bqc%N%(Z-!x zqn2M|QP*)^4aoR>*g2;&({|0idESyQNX3)E@Y?JT&idB1i$DYG4<;QQ(nY6db#JJL zm&LwK&TF&ZwQQ4|iwilfUzyI(m3KoM9`&=Xb8S-Jyc~8reR^YBmsc+J%yVnlYte<% z?{$EEEgb+pdVWk#PpEx*ic5=u!+2$O&XJ@_qquQzIP}oA@qkTmJ3Xf7$H#PxZ@tzv zN3L8bDTK?56FPo&LMMlZDm+@P=2$xYuTTi!?b9|LquA}WjQ`KpI|cXOVXM`W-TaaE zv1ahUt*^8n;hN;8IK?DJm7cE4ge}Y40H|UE>EOFiQ4X3pDOQ--yQ9-_G9fahEdP5J6-L&)zhD7 zPp-`FYtyyPI&0=1X&u3^$_Ox4ajo_T*le zpWU7z|rpI2xu=QEPpp+*ADK+hmwD^mE{s+bB_*(z~ diff --git a/sources/EDITINTERFACE b/sources/EDITINTERFACE index 6178291a..534b4746 100644 --- a/sources/EDITINTERFACE +++ b/sources/EDITINTERFACE @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 8-May-2022 22:49:56"  -{DSK}kaplan>local>medley3.5>my-medley>sources>EDITINTERFACE.;42 47143 +(FILECREATED "13-May-2022 08:16:23"  +{DSK}kaplan>Local>medley3.5>my-medley>sources>EDITINTERFACE.;44 47034 - :CHANGES-TO (FNS FIXEDITDATE) + :CHANGES-TO (FNS FIXEDITDATE EDITDATE?) - :PREVIOUS-DATE " 8-May-2022 17:05:15" -{DSK}kaplan>local>medley3.5>my-medley>sources>EDITINTERFACE.;41) + :PREVIOUS-DATE "12-May-2022 23:21:03" +{DSK}kaplan>Local>medley3.5>my-medley>sources>EDITINTERFACE.;43) (* ; " @@ -627,14 +627,21 @@ Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation. OLDATE INITLS]) (FIXEDITDATE - [LAMBDA (EXPR) (* ; "Edited 8-May-2022 22:49 by rmk") + [LAMBDA (EXPR) + + (* ;; "Edited 13-May-2022 08:11 by rmk") + + (* ;; "Edited 8-May-2022 22:49 by rmk") (* ;; "Edited 19-Jan-2022 23:08 by rmk") - (* ;; "Edited 8-Dec-2021 16:11 by rmk: Updated to add dates to the initial undated comments that begins with current-editor initials, to provide a kind of dated change-log capability.") - (* ; "Edited 27-Sep-2018 22:04 by rmk:") - (* ; "Edited 31-Mar-2000 17:13 by rmk:") - (* ; "Edited 17-Jul-89 11:13 by jtm:") + (* ;; "Edited 8-Dec-2021 16:11 by rmk: Updated to add dates to the initial undated comments that begins with current-editor initials, to provide a kind of dated change-log capability.") + + (* ;; "Edited 27-Sep-2018 22:04 by rmk:") + + (* ;; "Edited 31-Mar-2000 17:13 by rmk:") + + (* ;; "Edited 17-Jul-89 11:13 by jtm:") (* ; "18-JUL-78 21:11") (* ;; "Inserts or replaces previous edit date. This retains multiple edits (at least one day apart or by different editor) unless *REPLACE-OLD-EDIT-DATES*. Note that the new date doesn't show up within the current SEDIT session, you have to exit and re-edit to see it. ") @@ -695,10 +702,10 @@ Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation. (* ;; "E is now the cell that the date will attach to or whose CAR will be updated.") - (LET (PARSE (INITLS (CL:IF (EQ (CHARCODE %:) - (NTHCHARCODE INITIALS -1)) - (SUBSTRING INITIALS 1 -2) - INITIALS))) + [LET (PARSE COMMENTLEVEL (INITLS (CL:IF (EQ (CHARCODE %:) + (NTHCHARCODE INITIALS -1)) + (SUBSTRING INITIALS 1 -2) + INITIALS))) (IF *REPLACE-OLD-EDIT-DATES* THEN (* ;; "Strip out all previous modern-format edit dates. Since EDITDATE? only recognizes that format, hand editing is needed if prehistoric dates are really not desired. We don't strip out anything with a further comment.") @@ -719,66 +726,67 @@ Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation. (CADDR PARSE)) ELSE (/ATTACH (EDITDATE NIL INITLS) E)) - ELSEIF (SETQ PARSE (EDITDATE? (CAR E) - T)) - THEN - (* ;; "If edited by the same editor within a day, then update the previous timestamp rather than cluttering with a new one. Presumably this is the next event in the same longer editing session, and it avoids stacking up uninformative dates from in-and-out editing during a session. ") + ELSE (IF (SETQ PARSE (EDITDATE? (CAR E) + T)) + THEN - (IF [AND (STRING.EQUAL INITLS (CADR PARSE)) - (ILEQ (IDIFFERENCE (IDATE) - (IDATE (CAR PARSE))) - (CONSTANT (TIMES 24 3600] - THEN + (* ;; "If edited by the same editor within a day, then update the previous timestamp rather than cluttering with a new one. Presumably this is the next event in the same longer editing session, and it avoids stacking up uninformative dates from in-and-out editing during a session. ") - (* ;; "Same edit session with the same author: update the last previous timestamp. If the (CAR PARSE) is NIL, we are looking at an initialed comment that becomes a timestamp, and we convert it. If just after this we see another timestamp for the same session, we take that out.") + (IF [AND (STRING.EQUAL INITLS (CADR PARSE)) + (ILEQ (IDIFFERENCE (IDATE) + (CAR PARSE)) + (CONSTANT (TIMES 24 3600] + THEN + (* ;; + "Same edit session with the same author: update the last previous timestamp. ") - (/RPLACA E (EDITDATE (CAR E) - INITLS - (CADDR PARSE))) - ELSE - (* ;; + (/RPLACA E (EDITDATE (CAR E) + INITLS + (CADDR PARSE))) + ELSE + (* ;;  "Different edit sequence, attach a new timestamp in front of any old ones, without the rest") - (/ATTACH (EDITDATE NIL INITLS) - E)) - - (* ;; "If the new date has an upgraded comment-level, update all of the previous dates so that they align on the left instead of the right.") - - (CL:UNLESS (EQ (CADR (CAR E)) - ';) - (FOR PREV (NEWTYPE _ (CADR (CAR E))) IN (CDR E) - WHILE (EDITDATE? PREV) UNTIL (EQ (CADR PREV) - NEWTYPE) - DO (/RPLACA (CDR PREV) - NEWTYPE))) - ELSEIF (AND [EQ COMMENTFLG (CAR (LISTP (CAR E] - (MEMB [CAR (LISTP (SETQ PARSE (CDAR E] - '(; ;; ;;;)) - [STRINGP (SETQ PARSE (CAR (LISTP (CDR PARSE] - (STRPOS (CONCAT INITLS ": ") - PARSE 1 NIL NIL T)) - THEN - (* ;; + (/ATTACH (EDITDATE NIL INITLS) + E)) + ELSEIF (AND [EQ COMMENTFLG (CAR (LISTP (CAR E] + (MEMB [CAR (LISTP (SETQ PARSE (CDAR E] + '(; ;; ;;;)) + [STRINGP (SETQ PARSE (CAR (LISTP (CDR PARSE] + (STRPOS (CONCAT INITLS ": ") + PARSE 1 NIL NIL T)) + THEN + (* ;;  "Just an ordinary comment in first position, with initials: in front. Upgrade it to an edit date.") - (/RPLACA E (EDITDATE (CAR E) - NIL PARSE)) - ELSE - (* ;; + (/RPLACA E (EDITDATE (CAR E) + NIL PARSE)) + ELSE + (* ;;  "First edit: we didn't see an old date to compare with or smash, not even an initials: xxx form.") - (/ATTACH (EDITDATE NIL INITLS) - E))) + (/ATTACH (EDITDATE NIL INITLS) + E)) + + (* ;; "Make sure that all the previous dates have the same comment level.") + + [SETQ COMMENTLEVEL (CADR (FOR C CFLAG IN E WHILE (EDITDATE? C) + LARGEST (NCHARS (CADR C] + (FOR C IN E WHILE (EDITDATE? C) UNLESS (EQ (CADR C) + COMMENTLEVEL) + DO (/RPLACA (CDR C) + COMMENTLEVEL] (RETURN EXPR)))]) (EDITDATE? - [LAMBDA (COMMENT PARSE) (* ; "Edited 6-May-2022 23:39 by rmk") + [LAMBDA (COMMENT PARSE) (* ; "Edited 13-May-2022 08:05 by rmk") + (* ; "Edited 6-May-2022 23:39 by rmk") (* ;; "This determines whether this is a dated or initialed comment that is potentially reusable in the current context. It recognizes comments with edit-date strings of the following formats:") (* ;;; " %"Edited by (:)%"") -(* ;;; " %"Edited >date? by : %"") +(* ;;; " %"Edited by : %"") (* ;;; "Value is NIL if the comment is not in one of these formats. Otherwise, if PARSE, then the value is a list ( ), else T. ") @@ -799,8 +807,7 @@ Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation. STRING)) (CL:WHEN [AND [STREQUAL "Edited " (SUBSTRING STRING 1 7 (CONSTANT (CONCAT] (SETQ BYPOS (STRPOS " by " STRING 8)) - (IDATE (SETQ DATE (CL:STRING-TRIM `(#\Space) - (SUBSTRING STRING 8 (SUB1 BYPOS] + (SETQ DATE (IDATE (SUBSTRING STRING 8 (SUB1 BYPOS] (* ;; "Standard format, initials should be next. ") @@ -929,11 +936,11 @@ Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation. ) (PUTPROPS EDITINTERFACE COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 1991)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4079 10378 (ED 4079 . 10378)) (10380 14356 (INSTALL-PROTOTYPE-DEFN 10380 . 14356)) ( -14357 31140 (EDITDEF.FNS 14367 . 15703) (EDITF 15705 . 16585) (EDITFB 16587 . 17435) (EDITFNS 17437 . -18757) (EDITLOADFNS? 18759 . 22559) (EDITMODE 22561 . 24571) (EDITP 24573 . 25084) (EDITV 25086 . -25725) (DC 25727 . 26408) (DF 26410 . 27452) (DP 27454 . 28538) (DV 28540 . 29112) (EDITPROP 29114 . -29333) (EF 29335 . 29664) (EP 29666 . 29849) (EV 29851 . 30030) (EDITE 30032 . 30910) (EDITL 30912 . -31138)) (31490 46288 (NEW/EDITDATE 31500 . 31722) (FIXEDITDATE 31724 . 39842) (EDITDATE? 39844 . 42842 -) (EDITDATE 42844 . 44291) (SETINITIALS 44293 . 46286))))) + (FILEMAP (NIL (4089 10388 (ED 4089 . 10388)) (10390 14366 (INSTALL-PROTOTYPE-DEFN 10390 . 14366)) ( +14367 31150 (EDITDEF.FNS 14377 . 15713) (EDITF 15715 . 16595) (EDITFB 16597 . 17445) (EDITFNS 17447 . +18767) (EDITLOADFNS? 18769 . 22569) (EDITMODE 22571 . 24581) (EDITP 24583 . 25094) (EDITV 25096 . +25735) (DC 25737 . 26418) (DF 26420 . 27462) (DP 27464 . 28548) (DV 28550 . 29122) (EDITPROP 29124 . +29343) (EF 29345 . 29674) (EP 29676 . 29859) (EV 29861 . 30040) (EDITE 30042 . 30920) (EDITL 30922 . +31148)) (31500 46179 (NEW/EDITDATE 31510 . 31732) (FIXEDITDATE 31734 . 39703) (EDITDATE? 39705 . 42733 +) (EDITDATE 42735 . 44182) (SETINITIALS 44184 . 46177))))) STOP diff --git a/sources/EDITINTERFACE.LCOM b/sources/EDITINTERFACE.LCOM index c04f34c5f508f707f01a3f72b34b6818127df471..e8babab45aabfcb14775a39625b61287b9308d13 100644 GIT binary patch delta 1468 zcmaJ>&u<$=6!xr}CM2q5Lll|FvR)M+v!Y#(gRa2Z$ zL{OnZ$N?cCZiFq0is*$(QfjYQ-LQ-jDBl^WMz2 z`|CFPa~pkQPh&A=G;YU8oDhg7(>ReP;!f*T-|E)254SG08Xs&l-oKI*@~)IYL0MTYfU9PBW1#`6;a|6$Bj?;1Rf9fJ}|D2#Lcrl6Z-^62x z8QA%l?6Q?O0r8U<79k5|NI^EQE6dDEa$f>VDd^0lkTnfMEm^v{raJeI{LaAUC z6uk<0z|s*QuP?iP0(8Y#$|=>dUbWnS40*HS8cA?`n1vIo$6a>U8^gCNCJgyCKohAd$4v~8`hC|%$U6^p|7LoIw^jbS`d8*`nc-{29 zETEsYK;VoS^gd+6d%n#0?XZTtXwdtO4N&ug<4Fr2PkpXr;^-8F%cETE$3Mhm57raFSbP>m&LCn2>(C~)nIOj|?1 zyn1<6(Ls!l?nhE0EGU+xWHlg3`D8mHCr6xwc;IsMl+Z|b#;mDH_kc& zoJu-t^7$NQBj(hsu2dAOV3w-q(@gOaD7m#*xneS$guyjRfJGUW*x#Ut0TbzvqyomW z^GI$?Q4EnZM1bOigOj@#J^xG~kC15v-W|97nkxubAAf1Wo6l&%4gSu8=&hkHT>r6i zDiytOj|*gFV}gsJ#_3-(x7hlFM>zh9b2W9l?H)8A&7F*}=1P|4-eA_usX*8lJ(7)+ zXRhWE(+Jqf3kzH(Zk>;NMBPtu!X{{dcX BWflMc delta 1437 zcmaJ>O>7%Q6y8}kO-Mvyr>5#ph@Olp#VT=jW_P{bZArbcH`%qW5Tyz0*9Dc!SdSfS@>SpFY2ggYtTT!=^_>1^W>L=7?6 zA-i;yg7f0X=M)GJfC{9+F?{dMia~7&JlzU@6z4J-upG;?blZhxP$5??l?=yQwpZvD z3t;P|rM&J|Y}X4N7?#V`&>+DNi)UX=0zWl2!XZC;5V^OHX0j2s#0AnKNVDf&Hru~v(G8CN{L>TR@^<){IT#PVl}fGY?n4vty?FNvv%Tj>w~od`#HQB$ z%8xd;{$fcxel!+~_-DSe%osXhN4~bv3nA)Dn_p}HX4>6Hrp?k0PnqZ@vuX!ZCMpzp z9x;Z`3e0P=Z#LRP&2n7rn|*GF!Vn7_TpSB&i#_(>Q~6?RP+n)xiJOz@Ls+O*Y(1xgj1@5Qmd6H57BIM8 zwNiFLQUxlslhZvqiDKxroE170vH~Tev;@)+ha`{z#}yERU(;es28&UOm`+dMV&s%2 zWxT$s+d$OgqptwTD6pV=o}M$QjR%B46lrK9tAh>Ak<|W0@<7DlB4R|yfV;ZXs~fN? z1$)Ycf~ch765xygc_U}*Ro%17j(b4^oW`K%ug+Jh|RDE#}LP7o3VFB{ixZOk^95s-}twR+|SgB-WsUL zJqa8&DLi6Q7BD>p YodoTj0CTUbxwq=?t|vQxYFi_J1M!<#<^TWy