From 78b76f6801c362aff5aa34559820881c0081d956 Mon Sep 17 00:00:00 2001 From: Larry Masinter Date: Thu, 11 Aug 2022 10:56:27 -0700 Subject: [PATCH] GIT-INIT called after return to LOGOUT or SYSOUT etc; add option of making subdirectory to repo (#883) --- lispusers/GITFNS | 146 ++++++++++++++++++++++++------------------ lispusers/GITFNS.LCOM | Bin 47983 -> 48225 bytes 2 files changed, 82 insertions(+), 64 deletions(-) diff --git a/lispusers/GITFNS b/lispusers/GITFNS index 08769d04..bd379b57 100644 --- a/lispusers/GITFNS +++ b/lispusers/GITFNS @@ -1,12 +1,11 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "25-Jul-2022 15:14:26"  -{DSK}kaplan>local>medley3.5>working-medley>lispusers>GITFNS.;430 114311 +(FILECREATED " 9-Aug-2022 09:35:32" {DSK}larry>medley>lispusers>GITFNS.;5 115355 :CHANGES-TO (VARS GITFNSCOMS) + (FNS GIT-MAKE-PROJECT GIT-INIT GIT-INIT-MEDLEY) - :PREVIOUS-DATE "20-Jul-2022 21:20:33" -{DSK}kaplan>local>medley3.5>working-medley>lispusers>GITFNS.;429) + :PREVIOUS-DATE "25-Jul-2022 15:14:26" {DSK}larry>medley>lispusers>GITFNS.;1) (PRETTYCOMPRINT GITFNSCOMS) @@ -23,17 +22,21 @@ (* ;; "GIT projects") - (COMS (FNS GIT-CLONEP GIT-MAKE-PROJECT GIT-GET-PROJECT GIT-PROJECT-PATH + (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?) (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS GIT-PROJECT)) (INITVARS (GIT-DEFAULT-PROJECT 'MEDLEY) + [GIT-DEFAULT-PROJECTS '((MEDLEY T T + (EXPORTS.ALL RDSYS RDSYS.LCOM loadups/ patches/ + tmp/ fontsold/ clos/ cltl2/) + (greetfiles scripts sources library lispusers + internal doctools eooma)) + (NOTECARDS T T) + (LOOPS T T) + (TEST T T] (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) - (GIT-MAKE-PROJECT 'TEST T T)) + (P (GIT-INIT)) + (ADDVARS (AROUNDEXITFNS GIT-INIT)) (* ;; "") @@ -146,8 +149,19 @@ THEN NIL ELSE (ERROR "NOT A GIT CLONE" HOST/DIR]) +(GIT-INIT + [LAMBDA (EVENT) (* ; "Edited 8-Aug-2022 21:52 by lmm") + (SELECTQ EVENT + ((NIL AFTERLOGOUT AFTERMAKESYS AFTERSYSOUT AFTERSAVEVM) + (SETQ GIT-PROJECTS NIL) + (for X in GIT-DEFAULT-PROJECTS do (APPLY (FUNCTION GIT-MAKE-PROJECT) + X)) + NIL) + NIL]) + (GIT-MAKE-PROJECT [LAMBDA (PROJECTNAME PROJECTPATH WORKINGPATH EXCLUSIONS DEFAULTSUBDIRS) + (* ; "Edited 8-Aug-2022 22:03 by lmm") (* ; "Edited 13-Jul-2022 13:47 by rmk") (* ; "Edited 6-Jul-2022 19:34 by rmk") (* ; "Edited 17-May-2022 17:08 by rmk") @@ -173,7 +187,10 @@ (SETQ PROJECTNAME (U-CASE (MKATOM PROJECTNAME))) (CL:WHEN (MEMB PROJECTPATH '(NIL T)) - [SETQ PROJECTPATH (OR (GIT-CLONEP (UNIX-GETENV PROJECTNAME) + [SETQ PROJECTPATH (OR (GIT-CLONEP (MEDLEYDIR (L-CASE PROJECTNAME) + NIL NIL T) + T) + (GIT-CLONEP (UNIX-GETENV PROJECTNAME) T) (GIT-CLONEP (UNIX-GETENV (PACK* PROJECTNAME 'DIR)) T) @@ -192,21 +209,21 @@ 'DIRECTORY 'RETURN)) T)) - (SETQ CLONEPATH (IF (GIT-CLONEP PROJECTPATH T T) - ELSEIF (SETQ GITPATH (GIT-PROJECT-PATH PROJECTNAME PROJECTPATH)) - THEN (SETQ PROJECTPATH GITPATH) + (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))) + 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 + (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)) + 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 @@ -249,14 +266,14 @@ T))) (DIRECTORYNAME (TRUEFILENAME WORKINGPATH) T))) - [SETQ WORKINGPATH (IF WP - THEN (UNSLASHIT WP T) - ELSEIF (EQ WORKINGPATH T) - THEN NIL - ELSE (ERROR (CONCAT "Can't find the working directory " + [SETQ WORKINGPATH (if WP + then (UNSLASHIT WP T) + elseif (EQ WORKINGPATH T) + then NIL + else (ERROR (CONCAT "Can't find the working directory " (OR WORKINGPATH "") " for " PROJECTNAME] - (SETQ PROJECT (CREATE GIT-PROJECT + (SETQ PROJECT (create GIT-PROJECT PROJECTNAME _ PROJECTNAME GITHOST _ (PACK* "{" (PSEUDOHOST (CONCAT "G" PROJECTNAME) PROJECTPATH) @@ -269,7 +286,7 @@ DEFAULTSUBDIRS _ (MKLIST DEFAULTSUBDIRS) CLONEPATH _ CLONEPATH)) (/RPLACD [OR (ASSOC PROJECTNAME GIT-PROJECTS) - (CAR (PUSH GIT-PROJECTS (CONS PROJECTNAME] + (CAR (push GIT-PROJECTS (CONS PROJECTNAME] PROJECT) PROJECTNAME))]) @@ -367,17 +384,18 @@ (RPAQ? GIT-DEFAULT-PROJECT 'MEDLEY) +(RPAQ? GIT-DEFAULT-PROJECTS + '((MEDLEY T T (EXPORTS.ALL RDSYS RDSYS.LCOM loadups/ patches/ tmp/ fontsold/ clos/ cltl2/) + (greetfiles scripts sources library lispusers internal doctools eooma)) + (NOTECARDS T T) + (LOOPS T T) + (TEST T T))) + (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-INIT) -(GIT-MAKE-PROJECT 'NOTECARDS T T '(online/)) - -(GIT-MAKE-PROJECT 'LOOPS T T) - -(GIT-MAKE-PROJECT 'TEST T T) +(ADDTOVAR AROUNDEXITFNS GIT-INIT) @@ -2140,31 +2158,31 @@ (PUTPROPS GITFNS FILETYPE :TCOMPL) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3652 18184 (GIT-CLONEP 3662 . 4925) (GIT-MAKE-PROJECT 4927 . 13025) (GIT-GET-PROJECT -13027 . 14952) (GIT-PROJECT-PATH 14954 . 15998) (FIND-ANCESTOR-DIRECTORY 16000 . 16349) ( -GIT-FIND-CLONE 16351 . 17432) (GIT-MAINBRANCH 17434 . 17829) (GIT-MAINBRANCH? 17831 . 18182)) (24550 -27338 (ALLSUBDIRS 24560 . 25846) (MEDLEYSUBDIRS 25848 . 26541) (GITSUBDIRS 26543 . 27336)) (27339 -32129 (TOGIT 27349 . 28755) (FROMGIT 28757 . 29738) (GIT-DELETE-FILE 29740 . 30586) ( -MYMEDLEY-DELETE-FILES 30588 . 32127)) (32130 34662 (MYMEDLEYSUBDIR 32140 . 32596) (GITSUBDIR 32598 . -33041) (STRIPDIR 33043 . 33414) (STRIPHOST 33416 . 33656) (STRIPNAME 33658 . 34411) (STRIPWHERE 34413 - . 34660)) (34663 36565 (GFILE4MFILE 34673 . 35036) (MFILE4GFILE 35038 . 35607) (GIT-REPO-FILENAME -35609 . 36563)) (36614 46436 (GIT-COMMIT 36624 . 37450) (GIT-PUSH 37452 . 38096) (GIT-PULL 38098 . -38710) (GIT-APPROVAL 38712 . 39061) (GIT-GET-FILE 39063 . 41028) (GIT-FILE-EXISTS? 41030 . 41304) ( -GIT-REMOTE-UPDATE 41306 . 42030) (GIT-REMOTE-ADD 42032 . 42339) (GIT-FILE-DATE 42341 . 43272) ( -GIT-FILE-HISTORY 43274 . 45208) (GIT-PRINT-FILE-HISTORY 45210 . 46260) (GIT-FETCH 46262 . 46434)) ( -46466 57198 (GIT-BRANCH-DIFF 46476 . 53260) (GIT-COMMIT-DIFFS 53262 . 53815) (GIT-BRANCH-RELATIONS -53817 . 57196)) (57243 68045 (GIT-BRANCH-NUM 57253 . 57826) (GIT-CHECKOUT 57828 . 58887) ( -GIT-WHICH-BRANCH 58889 . 59187) (GIT-MAKE-BRANCH 59189 . 61402) (GIT-BRANCHES 61404 . 63377) ( -GIT-BRANCH-EXISTS? 63379 . 64083) (GIT-PICK-BRANCH 64085 . 64413) (GIT-PRC-MENU 64415 . 66163) ( -GIT-PULL-REQUESTS 66165 . 67431) (GIT-SHORT-BRANCH-NAME 67433 . 67724) (GIT-LONG-NAME 67726 . 68043)) -(68075 71410 (GIT-MY-CURRENT-BRANCH 68085 . 68455) (GIT-MY-BRANCHP 68457 . 68962) (GIT-MY-NEXT-BRANCH -68964 . 69458) (GIT-MY-BRANCHES 69460 . 71408)) (71456 75408 (GIT-ADD-WORKTREE 71466 . 72950) ( -GIT-REMOVE-WORKTREE 72952 . 73882) (GIT-LIST-WORKTREES 73884 . 74688) (WORKTREEDIR 74690 . 75406)) ( -75456 105657 (GIT-GET-DIFFERENT-FILES 75466 . 81291) (GIT-BRANCHES-COMPARE-DIRECTORIES 81293 . 87274) -(GIT-WORKING-COMPARE-DIRECTORIES 87276 . 92102) (GIT-COMPARE-WORKTREE 92104 . 96082) (GITCDOBJBUTTONFN - 96084 . 100574) (GIT-CD-LABELFN 100576 . 101658) (GIT-CD-MENUFN 101660 . 103867) ( -GIT-WORKING-COMPARE-FILES 103869 . 104489) (GIT-BRANCHES-COMPARE-FILES 104491 . 105655)) (105727 -114244 (CDGITDIR 105737 . 106297) (GIT-COMMAND 106299 . 107857) (GITORIGIN 107859 . 108556) ( -GIT-INITIALS 108558 . 108862) (GIT-COMMAND-TO-FILE 108864 . 112353) (PROCESS-COMMAND 112355 . 112968) -(GIT-RESULT-TO-LINES 112970 . 113577) (STRIPLOCAL 113579 . 114242))))) + (FILEMAP (NIL (3965 19213 (GIT-CLONEP 3975 . 5238) (GIT-INIT 5240 . 5667) (GIT-MAKE-PROJECT 5669 . +14054) (GIT-GET-PROJECT 14056 . 15981) (GIT-PROJECT-PATH 15983 . 17027) (FIND-ANCESTOR-DIRECTORY 17029 + . 17378) (GIT-FIND-CLONE 17380 . 18461) (GIT-MAINBRANCH 18463 . 18858) (GIT-MAINBRANCH? 18860 . 19211 +)) (25594 28382 (ALLSUBDIRS 25604 . 26890) (MEDLEYSUBDIRS 26892 . 27585) (GITSUBDIRS 27587 . 28380)) ( +28383 33173 (TOGIT 28393 . 29799) (FROMGIT 29801 . 30782) (GIT-DELETE-FILE 30784 . 31630) ( +MYMEDLEY-DELETE-FILES 31632 . 33171)) (33174 35706 (MYMEDLEYSUBDIR 33184 . 33640) (GITSUBDIR 33642 . +34085) (STRIPDIR 34087 . 34458) (STRIPHOST 34460 . 34700) (STRIPNAME 34702 . 35455) (STRIPWHERE 35457 + . 35704)) (35707 37609 (GFILE4MFILE 35717 . 36080) (MFILE4GFILE 36082 . 36651) (GIT-REPO-FILENAME +36653 . 37607)) (37658 47480 (GIT-COMMIT 37668 . 38494) (GIT-PUSH 38496 . 39140) (GIT-PULL 39142 . +39754) (GIT-APPROVAL 39756 . 40105) (GIT-GET-FILE 40107 . 42072) (GIT-FILE-EXISTS? 42074 . 42348) ( +GIT-REMOTE-UPDATE 42350 . 43074) (GIT-REMOTE-ADD 43076 . 43383) (GIT-FILE-DATE 43385 . 44316) ( +GIT-FILE-HISTORY 44318 . 46252) (GIT-PRINT-FILE-HISTORY 46254 . 47304) (GIT-FETCH 47306 . 47478)) ( +47510 58242 (GIT-BRANCH-DIFF 47520 . 54304) (GIT-COMMIT-DIFFS 54306 . 54859) (GIT-BRANCH-RELATIONS +54861 . 58240)) (58287 69089 (GIT-BRANCH-NUM 58297 . 58870) (GIT-CHECKOUT 58872 . 59931) ( +GIT-WHICH-BRANCH 59933 . 60231) (GIT-MAKE-BRANCH 60233 . 62446) (GIT-BRANCHES 62448 . 64421) ( +GIT-BRANCH-EXISTS? 64423 . 65127) (GIT-PICK-BRANCH 65129 . 65457) (GIT-PRC-MENU 65459 . 67207) ( +GIT-PULL-REQUESTS 67209 . 68475) (GIT-SHORT-BRANCH-NAME 68477 . 68768) (GIT-LONG-NAME 68770 . 69087)) +(69119 72454 (GIT-MY-CURRENT-BRANCH 69129 . 69499) (GIT-MY-BRANCHP 69501 . 70006) (GIT-MY-NEXT-BRANCH +70008 . 70502) (GIT-MY-BRANCHES 70504 . 72452)) (72500 76452 (GIT-ADD-WORKTREE 72510 . 73994) ( +GIT-REMOVE-WORKTREE 73996 . 74926) (GIT-LIST-WORKTREES 74928 . 75732) (WORKTREEDIR 75734 . 76450)) ( +76500 106701 (GIT-GET-DIFFERENT-FILES 76510 . 82335) (GIT-BRANCHES-COMPARE-DIRECTORIES 82337 . 88318) +(GIT-WORKING-COMPARE-DIRECTORIES 88320 . 93146) (GIT-COMPARE-WORKTREE 93148 . 97126) (GITCDOBJBUTTONFN + 97128 . 101618) (GIT-CD-LABELFN 101620 . 102702) (GIT-CD-MENUFN 102704 . 104911) ( +GIT-WORKING-COMPARE-FILES 104913 . 105533) (GIT-BRANCHES-COMPARE-FILES 105535 . 106699)) (106771 +115288 (CDGITDIR 106781 . 107341) (GIT-COMMAND 107343 . 108901) (GITORIGIN 108903 . 109600) ( +GIT-INITIALS 109602 . 109906) (GIT-COMMAND-TO-FILE 109908 . 113397) (PROCESS-COMMAND 113399 . 114012) +(GIT-RESULT-TO-LINES 114014 . 114621) (STRIPLOCAL 114623 . 115286))))) STOP diff --git a/lispusers/GITFNS.LCOM b/lispusers/GITFNS.LCOM index 517abd24e6d7e7d9b4243b1d9b4b733636c67e13..cef0ccb775959f4d5b51e05f84a0b67ba783be97 100644 GIT binary patch delta 2360 zcmb7FUvC>l5RaXv64#JYHEkvSRKuYPJF4B=-TP}$$kn$=++6N1cjq*b%0q}vVv)p^ zlL|#uALH}pu2LpEJI^u2a!E54yAHYDood0UJbb& za|gjcn;|{OsQV%*0U;XGG^kW(ZEuE0rPzmpv}lKs0F7x^{rRW}1(cr6;z)iX(b7D3 zT)td{N)U2svF6vKl7mo_$=tb;^gl{X_F4XyTsbXX#WAHq017NY4ZnPmdofG{N%8aw z8li$F!Q=5Rf*o>l`JvoYPscor>_xsf4^)SX*?c+j>oE``GmF+o%MqB_ z)b(f3iY}90uB%Y@BG-;)k>|Rmf>R55T#fy3*|X<4=&A{E zSm%PbnF6aaKNrPe&6@$u%Gy|UeUAsA84Rj!1!oZl4U2zme$lNVR1F;`{|uiU)l>!i zfP0`ZmgG*Hd0(SuAB#pza7$HN>?I0B^~?Pz3IP-YKLXW6@xY)O`hkJ56#5}@l^Ph~ z>=nE{dKFL!?FUd5b-)j^w7wr^pm-2~8Hgi`%&3yAoH$!#iU!w^RNQkYFhx0>P~C!> zCkhoHl~j@50>#E;MW<99WPB;G<5{3YOO?I)QS{yK1+lEOr3Zy4mS|OS=frrI7}n9I z5Y^~~AsDciF6l+=IVV_N(cHrd5rXZ?2t*XtFO7Kw5=N?fwWZPwkGZ#qL_<(qkP*oz z?vH-wwIjN7OTjn z%f7P=DlWn6A4e6^Bf*fZsfDRX2edF|_AFTGj80{~P`6!RNU=&c=EzQ}^>$I*o|2rH z7T__chaM0!I}>Ty@Jbk<84%q}(?)@1VJte3D)Ip{#)|^aFa`OR3MY^Am5as zY%n7;P*lvI0bvS*jt5JI58EC5>ZT4d4u<*Z*xN12K%SKGAfR${w}cXQLcW9}9!z0j zCc65#-TA1swT5Q#ItVjGju+%cbEAn56wc*|^7ig_`^Ju3!~&qx@>*-BwYJsnG-U}W z)05j{Z{%_KX6%AQ6f<>V8T-GE4JYT)i(L{e9_$Vzf83ePNr}F9KB@01 zM@}M$s>*jHB&7WZkWx`}Muq zlb2J!{xS9W{rKnH>+eB9deqz5ZFgE*(CdN(`6rcd{pq_0d#(Q7^5f=ir`cWZ^d2=k z%R8;DPV0~A68KSCZv1uh89ND%I zOEXOf8!M@fW|RO$-wQ$GD2^|VWzueqZv?hlOp&i(+f*N zvALth;mi%o?FZgn%uM#JXbnh-P4Xo1oztK5)2F7|shrDi3cMMQ-2?Bl_ruVhKmw zQpCN6g%1_-t&FXUfU?wxqV;e9h;9ImNF#88=%aZVk_-qZgK;^4X!o{~0eAw&bzpiT_ z;lg#0>}EG!n3LKn0clwRExFn`lu^RcN=p(}7ycHAa@@tPvX3({7r)51p? z_tK)WcevL(*q4e}1_V{M+xzY9Zm-{x@<53ee?9ls6fWP-EnGD*0JJgq@t~;BdCO%;pks+@V!P<`b@b}OqFBnxiTmg^SICOPW`8FE@Iji;uOy~>2*8p zZfmJn{0CFV^Zbz+Dka~HVZi4dTuB&{fFIxb@|)S4Y5F0!H3$2gStV({G7&-i`&aJy eG$z!~JNefv#-7fbPGs@-N|BgNlX&^OJ@*%MYA{Ry