From d34522d769468ecd747e731d4d7a3405564269eb Mon Sep 17 00:00:00 2001 From: rmkaplan <69548581+rmkaplan@users.noreply.github.com> Date: Thu, 30 Mar 2023 09:59:27 -0700 Subject: [PATCH] GITNFS: Doesn't error if clonepath defaults but is not required (#1123) If CLONEPATH is NIL, no error if the clone can't be found, just prints a note. If CLONEPATH is T, will error. --- lispusers/GITFNS | 214 ++++++++++++++++++++++++------------------ lispusers/GITFNS.LCOM | Bin 48501 -> 48971 bytes 2 files changed, 124 insertions(+), 90 deletions(-) diff --git a/lispusers/GITFNS b/lispusers/GITFNS index fd6d6381..0dbc6b1b 100644 --- a/lispusers/GITFNS +++ b/lispusers/GITFNS @@ -1,12 +1,10 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 5-Feb-2023 12:43:27"  -{DSK}kaplan>Local>medley3.5>working-medley>lispusers>GITFNS.;467 117168 +(FILECREATED "30-Mar-2023 09:08:48" {WMEDLEY}GITFNS.;469 119763 :CHANGES-TO (FNS GIT-MAKE-PROJECT) - :PREVIOUS-DATE " 1-Feb-2023 18:54:25" -{DSK}kaplan>Local>medley3.5>working-medley>lispusers>GITFNS.;466) + :PREVIOUS-DATE "11-Mar-2023 23:12:35" {WMEDLEY}GITFNS.;468) (PRETTYCOMPRINT GITFNSCOMS) @@ -23,8 +21,9 @@ (* ;; "GIT projects") - (COMS (FNS GIT-CLONEP GIT-INIT GIT-MAKE-PROJECT GIT-GET-PROJECT GIT-PROJECT-PATH - FIND-ANCESTOR-DIRECTORY GIT-FIND-CLONE GIT-MAINBRANCH GIT-MAINBRANCH?) + (COMS (FNS GIT-CLONEP GIT-INIT GIT-MAKE-PROJECT GIT-GET-PROJECT GIT-PUT-PROJECT-FIELD + GIT-PROJECT-PATH FIND-ANCESTOR-DIRECTORY GIT-FIND-CLONE GIT-MAINBRANCH + GIT-MAINBRANCH?) (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS GIT-PROJECT PULLREQUEST)) (INITVARS (GIT-DEFAULT-PROJECT 'MEDLEY) [GIT-DEFAULT-PROJECTS '((MEDLEY NIL NIL @@ -165,6 +164,7 @@ (GIT-MAKE-PROJECT [LAMBDA (PROJECTNAME CLONEPATH WORKINGPATH EXCLUSIONS DEFAULTSUBDIRS) + (* ; "Edited 30-Mar-2023 09:06 by rmk") (* ; "Edited 5-Feb-2023 12:43 by rmk") (* ; "Edited 1-Feb-2023 16:55 by rmk") (* ; "Edited 11-Aug-2022 17:54 by rmk") @@ -212,7 +212,10 @@ PROJECTNAME) "/")) T) - (ERROR (CONCAT "Can't a find clone directory for " PROJECTNAME))) + (CL:IF CLONEPATH + (ERROR (CONCAT "Can't find a clone directory for " PROJECTNAME)) + (PRINTOUT T "Note: Can't find a clone directory for " + PROJECTNAME T))) elseif (GIT-CLONEP (SLASHIT (PACKFILENAME 'HOST 'DSK 'DIRECTORY (UNPACKFILENAME.STRING (TRUEFILENAME CLONEPATH) @@ -220,64 +223,66 @@ 'RETURN)) T) T T) - else (ERROR (CONCAT "Can't find clone directory " CLONEPATH " for " PROJECTNAME - ] - (LET (GITIGNORE PROJECT WP) - (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))) + else (ERROR (CONCAT "Can't find the clone directory " CLONEPATH " for " + PROJECTNAME] + (CL:WHEN CLONEPATH + (LET (GITIGNORE PROJECT WP) + (CL:WHEN (SETQ GITIGNORE (INFILEP (PACKFILENAME.STRING 'NAME ".gitignore" 'BODY + CLONEPATH))) + (SETQ GITIGNORE (CL:WITH-OPEN-FILE (STREAM GITIGNORE) + (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))) - (* ;; "We now have the clonepath and the extra parameters for the project. Do we have a separate working environment?") + (* ;; "We now have the clonepath and the extra parameters for the project. Do we have a separate working environment?") - (SETQ WP - (SELECTQ WORKINGPATH - ((T NIL) - (DIRECTORYNAME (PACKFILENAME.STRING 'HOST 'DSK 'BODY - (CONCAT (SUBSTRING CLONEPATH 1 - (STRPOS "/" CLONEPATH -2 NIL NIL NIL - FILEDIRCASEARRAY T)) - "working-" - (OR (SUBSTRING CLONEPATH - (OR (STRPOS CLONEPATH CLONEPATH 1 NIL NIL - T FILEDIRCASEARRAY) - -2)) - (L-CASE PROJECTNAME)) - ">")) - T)) - (DIRECTORYNAME (TRUEFILENAME WORKINGPATH) - T))) - [SETQ WORKINGPATH (if WP - then (UNSLASHIT WP T) - elseif WORKINGPATH - then (ERROR (CONCAT "Can't find the working directory " - (AND (EQ WORKINGPATH T) - "") - " for " PROJECTNAME] - (SETQ PROJECT (create GIT-PROJECT - PROJECTNAME _ PROJECTNAME - GITHOST _ (PACK* "{" (PSEUDOHOST PROJECTNAME CLONEPATH) - "}") - WHOST _ (AND WORKINGPATH (PACK* "{" (PSEUDOHOST (CONCAT "W" PROJECTNAME - ) - WORKINGPATH) - "}")) - EXCLUSIONS _ EXCLUSIONS - DEFAULTSUBDIRS _ (MKLIST DEFAULTSUBDIRS) - CLONEPATH _ CLONEPATH)) - (/RPLACD [OR (ASSOC PROJECTNAME GIT-PROJECTS) - (CAR (push GIT-PROJECTS (CONS PROJECTNAME] - PROJECT) - PROJECTNAME]) + (SETQ WP + (SELECTQ WORKINGPATH + ((T NIL) + (DIRECTORYNAME (PACKFILENAME.STRING 'HOST 'DSK 'BODY + (CONCAT (SUBSTRING CLONEPATH 1 + (STRPOS "/" CLONEPATH -2 NIL NIL NIL + FILEDIRCASEARRAY T)) + "working-" + (OR (SUBSTRING CLONEPATH + (OR (STRPOS CLONEPATH CLONEPATH 1 NIL + NIL T FILEDIRCASEARRAY) + -2)) + (L-CASE PROJECTNAME)) + ">")) + T)) + (DIRECTORYNAME (TRUEFILENAME WORKINGPATH) + T))) + [SETQ WORKINGPATH (if WP + then (UNSLASHIT WP T) + elseif WORKINGPATH + then (ERROR (CONCAT "Can't find the working directory " + (AND (EQ WORKINGPATH T) + "") + " for " PROJECTNAME] + (SETQ PROJECT (create GIT-PROJECT + PROJECTNAME _ PROJECTNAME + GITHOST _ (PACK* "{" (PSEUDOHOST PROJECTNAME CLONEPATH) + "}") + WHOST _ (AND WORKINGPATH (PACK* "{" (PSEUDOHOST (CONCAT "W" + PROJECTNAME) + WORKINGPATH) + "}")) + EXCLUSIONS _ EXCLUSIONS + DEFAULTSUBDIRS _ (MKLIST DEFAULTSUBDIRS) + CLONEPATH _ CLONEPATH)) + (/RPLACD [OR (ASSOC PROJECTNAME GIT-PROJECTS) + (CAR (push GIT-PROJECTS (CONS PROJECTNAME] + PROJECT) + PROJECTNAME))]) (GIT-GET-PROJECT [LAMBDA (PROJECT FIELD NOERROR) (* ; "Edited 7-Jul-2022 11:25 by rmk") @@ -308,6 +313,34 @@ ]) PROJECT))]) +(GIT-PUT-PROJECT-FIELD + [LAMBDA (PROJECT FIELD NEWVALUE) (* ; "Edited 11-Mar-2023 23:00 by rmk") + (* ; "Edited 7-Jul-2022 11:25 by rmk") + (* ; "Edited 13-May-2022 10:40 by rmk") + (* ; "Edited 9-May-2022 20:02 by rmk") + (* ; "Edited 8-May-2022 11:38 by rmk") + + (* ;; "Replaces the value of a project field with NEWVALUE. The project record is DONTCOPY, to avoid potential name conflicts, so this provides a functional interface. One use: augment EXCLUSIONS with a list of temporary debug and testing files that you don't want to see in the various file listings") + + (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 (REPLACE PROJECTNAME OF PROJECT WITH NEWVALUE)) + (WHOST (REPLACE WHOST OF PROJECT WITH NEWVALUE)) + (GITHOST (REPLACE GITHOST OF PROJECT WITH NEWVALUE)) + (EXCLUSIONS (REPLACE EXCLUSIONS OF PROJECT WITH NEWVALUE)) + (DEFAULTSUBDIRS + (REPLACE DEFAULTSUBDIRS OF PROJECT WITH NEWVALUE)) + (CLONEPATH (REPLACE CLONEPATH OF PROJECT WITH NEWVALUE)) + (MAINBRANCH (REPLACE MAINBRANCH OF PROJECT WITH NEWVALUE)) + PROJECT))]) + (GIT-PROJECT-PATH [LAMBDA (PROJECTNAME PROJECTPATH) (* ; "Edited 8-May-2022 15:10 by rmk") @@ -2201,31 +2234,32 @@ (PUTPROPS GITFNS FILETYPE :TCOMPL) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4019 18210 (GIT-CLONEP 4029 . 5292) (GIT-INIT 5294 . 5924) (GIT-MAKE-PROJECT 5926 . -12911) (GIT-GET-PROJECT 12913 . 14838) (GIT-PROJECT-PATH 14840 . 15884) (FIND-ANCESTOR-DIRECTORY 15886 - . 16235) (GIT-FIND-CLONE 16237 . 17318) (GIT-MAINBRANCH 17320 . 17715) (GIT-MAINBRANCH? 17717 . 18208 -)) (24637 27425 (ALLSUBDIRS 24647 . 25933) (MEDLEYSUBDIRS 25935 . 26628) (GITSUBDIRS 26630 . 27423)) ( -27426 32216 (TOGIT 27436 . 28842) (FROMGIT 28844 . 29825) (GIT-DELETE-FILE 29827 . 30673) ( -MYMEDLEY-DELETE-FILES 30675 . 32214)) (32217 35220 (MYMEDLEYSUBDIR 32227 . 32683) (GITSUBDIR 32685 . -33128) (STRIPDIR 33130 . 33501) (STRIPHOST 33503 . 33743) (STRIPNAME 33745 . 34498) (STRIPWHERE 34500 - . 35218)) (35221 37123 (GFILE4MFILE 35231 . 35594) (MFILE4GFILE 35596 . 36165) (GIT-REPO-FILENAME -36167 . 37121)) (37172 46994 (GIT-COMMIT 37182 . 38008) (GIT-PUSH 38010 . 38654) (GIT-PULL 38656 . -39268) (GIT-APPROVAL 39270 . 39619) (GIT-GET-FILE 39621 . 41586) (GIT-FILE-EXISTS? 41588 . 41862) ( -GIT-REMOTE-UPDATE 41864 . 42588) (GIT-REMOTE-ADD 42590 . 42897) (GIT-FILE-DATE 42899 . 43830) ( -GIT-FILE-HISTORY 43832 . 45766) (GIT-PRINT-FILE-HISTORY 45768 . 46818) (GIT-FETCH 46820 . 46992)) ( -47024 57617 (GIT-BRANCH-DIFF 47034 . 53374) (GIT-COMMIT-DIFFS 53376 . 53929) (GIT-BRANCH-RELATIONS -53931 . 57615)) (57662 69894 (GIT-BRANCH-NUM 57672 . 58245) (GIT-CHECKOUT 58247 . 59306) ( -GIT-WHICH-BRANCH 59308 . 59606) (GIT-MAKE-BRANCH 59608 . 61821) (GIT-BRANCHES 61823 . 64091) ( -GIT-BRANCH-EXISTS? 64093 . 64797) (GIT-PICK-BRANCH 64799 . 65127) (GIT-PRC-MENU 65129 . 67132) ( -GIT-PULL-REQUESTS 67134 . 69280) (GIT-SHORT-BRANCH-NAME 69282 . 69573) (GIT-LONG-NAME 69575 . 69892)) -(69924 73259 (GIT-MY-CURRENT-BRANCH 69934 . 70304) (GIT-MY-BRANCHP 70306 . 70811) (GIT-MY-NEXT-BRANCH -70813 . 71307) (GIT-MY-BRANCHES 71309 . 73257)) (73305 77257 (GIT-ADD-WORKTREE 73315 . 74799) ( -GIT-REMOVE-WORKTREE 74801 . 75731) (GIT-LIST-WORKTREES 75733 . 76537) (WORKTREEDIR 76539 . 77255)) ( -77305 108514 (GIT-GET-DIFFERENT-FILES 77315 . 83739) (GIT-BRANCHES-COMPARE-DIRECTORIES 83741 . 89898) -(GIT-WORKING-COMPARE-DIRECTORIES 89900 . 94726) (GIT-COMPARE-WORKTREE 94728 . 98706) (GITCDOBJBUTTONFN - 98708 . 103198) (GIT-CD-LABELFN 103200 . 104282) (GIT-CD-MENUFN 104284 . 106724) ( -GIT-WORKING-COMPARE-FILES 106726 . 107346) (GIT-BRANCHES-COMPARE-FILES 107348 . 108512)) (108584 -117101 (CDGITDIR 108594 . 109154) (GIT-COMMAND 109156 . 110714) (GITORIGIN 110716 . 111413) ( -GIT-INITIALS 111415 . 111719) (GIT-COMMAND-TO-FILE 111721 . 115210) (PROCESS-COMMAND 115212 . 115825) -(GIT-RESULT-TO-LINES 115827 . 116434) (STRIPLOCAL 116436 . 117099))))) + (FILEMAP (NIL (3979 20805 (GIT-CLONEP 3989 . 5252) (GIT-INIT 5254 . 5884) (GIT-MAKE-PROJECT 5886 . +13487) (GIT-GET-PROJECT 13489 . 15414) (GIT-PUT-PROJECT-FIELD 15416 . 17433) (GIT-PROJECT-PATH 17435 + . 18479) (FIND-ANCESTOR-DIRECTORY 18481 . 18830) (GIT-FIND-CLONE 18832 . 19913) (GIT-MAINBRANCH 19915 + . 20310) (GIT-MAINBRANCH? 20312 . 20803)) (27232 30020 (ALLSUBDIRS 27242 . 28528) (MEDLEYSUBDIRS +28530 . 29223) (GITSUBDIRS 29225 . 30018)) (30021 34811 (TOGIT 30031 . 31437) (FROMGIT 31439 . 32420) +(GIT-DELETE-FILE 32422 . 33268) (MYMEDLEY-DELETE-FILES 33270 . 34809)) (34812 37815 (MYMEDLEYSUBDIR +34822 . 35278) (GITSUBDIR 35280 . 35723) (STRIPDIR 35725 . 36096) (STRIPHOST 36098 . 36338) (STRIPNAME + 36340 . 37093) (STRIPWHERE 37095 . 37813)) (37816 39718 (GFILE4MFILE 37826 . 38189) (MFILE4GFILE +38191 . 38760) (GIT-REPO-FILENAME 38762 . 39716)) (39767 49589 (GIT-COMMIT 39777 . 40603) (GIT-PUSH +40605 . 41249) (GIT-PULL 41251 . 41863) (GIT-APPROVAL 41865 . 42214) (GIT-GET-FILE 42216 . 44181) ( +GIT-FILE-EXISTS? 44183 . 44457) (GIT-REMOTE-UPDATE 44459 . 45183) (GIT-REMOTE-ADD 45185 . 45492) ( +GIT-FILE-DATE 45494 . 46425) (GIT-FILE-HISTORY 46427 . 48361) (GIT-PRINT-FILE-HISTORY 48363 . 49413) ( +GIT-FETCH 49415 . 49587)) (49619 60212 (GIT-BRANCH-DIFF 49629 . 55969) (GIT-COMMIT-DIFFS 55971 . 56524 +) (GIT-BRANCH-RELATIONS 56526 . 60210)) (60257 72489 (GIT-BRANCH-NUM 60267 . 60840) (GIT-CHECKOUT +60842 . 61901) (GIT-WHICH-BRANCH 61903 . 62201) (GIT-MAKE-BRANCH 62203 . 64416) (GIT-BRANCHES 64418 . +66686) (GIT-BRANCH-EXISTS? 66688 . 67392) (GIT-PICK-BRANCH 67394 . 67722) (GIT-PRC-MENU 67724 . 69727) + (GIT-PULL-REQUESTS 69729 . 71875) (GIT-SHORT-BRANCH-NAME 71877 . 72168) (GIT-LONG-NAME 72170 . 72487) +) (72519 75854 (GIT-MY-CURRENT-BRANCH 72529 . 72899) (GIT-MY-BRANCHP 72901 . 73406) ( +GIT-MY-NEXT-BRANCH 73408 . 73902) (GIT-MY-BRANCHES 73904 . 75852)) (75900 79852 (GIT-ADD-WORKTREE +75910 . 77394) (GIT-REMOVE-WORKTREE 77396 . 78326) (GIT-LIST-WORKTREES 78328 . 79132) (WORKTREEDIR +79134 . 79850)) (79900 111109 (GIT-GET-DIFFERENT-FILES 79910 . 86334) ( +GIT-BRANCHES-COMPARE-DIRECTORIES 86336 . 92493) (GIT-WORKING-COMPARE-DIRECTORIES 92495 . 97321) ( +GIT-COMPARE-WORKTREE 97323 . 101301) (GITCDOBJBUTTONFN 101303 . 105793) (GIT-CD-LABELFN 105795 . +106877) (GIT-CD-MENUFN 106879 . 109319) (GIT-WORKING-COMPARE-FILES 109321 . 109941) ( +GIT-BRANCHES-COMPARE-FILES 109943 . 111107)) (111179 119696 (CDGITDIR 111189 . 111749) (GIT-COMMAND +111751 . 113309) (GITORIGIN 113311 . 114008) (GIT-INITIALS 114010 . 114314) (GIT-COMMAND-TO-FILE +114316 . 117805) (PROCESS-COMMAND 117807 . 118420) (GIT-RESULT-TO-LINES 118422 . 119029) (STRIPLOCAL +119031 . 119694))))) STOP diff --git a/lispusers/GITFNS.LCOM b/lispusers/GITFNS.LCOM index 602697f497bd60d8e5ae71e8f1fa7e11817103f7..70a03829d00b118f34c2abc5a07bf8e489c6c231 100644 GIT binary patch delta 1719 zcmZux-D@0G6yFcpq!SueNSmlo4i~K1(%sD5`Pi97C`lf}Ag zmxWS7SnUt+fS;_;e6j`|_$OPueM*F?@n>QMDXt#jCcCD&cOnq(VwcW#+ zmz69qgeu35lr8c?ky8ll{+4@tT$9h|3DnoS80dK}R3uque#tO(&DB+3uK;;|LeC^H zsQ||*1&I&8ONvO2CBhduTI9tO87JkwntGB-a|J$JJoRUMs(Vt{I6W8BADliY|H7ma zr_^==KPLKpbwBZa=}bg5WBw@p;r+xvrDKDWy2oLA;>F2Fu|bImZ%)i6zYf2dxR}{i zzZeRmXos8OkGEzfo3Z<$6F#1BCh89`c=BQY^5ny0uRsg1;5w$NRX~zOa8zyO5=aH4 zJUyt`%eLo(Bq^ZTmZl;pvLhP-sWBVMg6_Ju3lb-etVLOX!17GhTQ+h# z+tDo$!u6@yo`AuIX$qnYW=>NhKg`$*%EOR?zyXqu?SVj%JXUbhNWn`|bgipb?NvQj z2^`bF(sd7bk%MchgEv+v@PahPV9is86_w!t&#~d&*7;tcFhqnF=qNEN@^HoQb6Asw zrWAvW;Gq$q2>(+oC@&&<T*_o<&R zNZ9V^ddIcj#6Ez?N>EhGwu_j`3SxS$hm|P;l(wq?Z?@{t-D-sP^tr_Xnpo{_ zqX=Wlb=bJkZZ)9Z>@+sI?au9CT3l4ZxLw$tzMN$GUrv`&BzW40+>)W26)09@X5Ih_ zmR?&`%|H)-oqnSSOOeEmw<`;YZxiW6x>QdmH=_;ztA8P0?xVDG^?d5+1$TGrI;-!eNlR1HmB9AnxZw zQ7kKE67#$=Tm#&&Al^xQg*jZMs%lteSGBZd;CS4ScqLRHxoAN2B{eX8T+l4O86GGS z=x=Fe;2E~%fy_l?Jb0W0sKtcH_U~m5!puojLv#O9hKZ(r$*?Me&4cix{nZTP1g7cY aB;x>QvoIh2v0qCv;VTDX|MtCqXa5I|y{pCm delta 1431 zcmbVM&ub%99B;C=(OI{OblpNhzC5HRi%I9bH$Rdfq0`B9cg$oa&P=)#x`)`z*0|YB zNh4C0B_eq9puC%)h)6w&mf+s>BzW*3p8Rp~4-oX^WfAc^lcue*7tJB>`}_NOpYMF% zw|`~-c#wVP#x|(M&FJMKlNkrfstT_%oj{)K#&`C6{iqA^00>BT>p|n*3+;nwcu>3D z+3$A-H7DNf^lNvbZa+HYCAIc?JiOf->=mb$nlLg;D|!Kw`MC~qm9eT^#)|LWFOJW< zN~IEkZfAroACf{jDMGLYMF!O`<@S~ zUY__V8>`-hdKi;SI!iMceLFEbqkozvH8=Rc-JWbOgW{C z;TB!9!y;b6O+u*#Gd38NQzlQZ&SVwI68qB962+YCK#|AO!2(4dlP*+Ord=pw(6s7~wT(fzwfLcNAomDp zOapQwIVq64c;fIAyIMgz>Z;Cgt#8G{WVsO!na2}H|MsQTG1DX>)FYNPYs30A3ghIGNn!1txrb} xlGr)gT5h!+$491-;6efNlI_~zmf;8D_oK_=m!oP9T-!mr$b7ao@jm(U%HK-^d8GgV