GIT-INIT called after return to LOGOUT or SYSOUT etc; add option of making subdirectory to repo (#883)

lispusers/GITFNS

@@ -1,12 +1,11 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "25-Jul-2022 15:14:26" 
-{DSK}<users>kaplan>local>medley3.5>working-medley>lispusers>GITFNS.;430
 114311 
+
(FILECREATED " 9-Aug-2022 09:35:32" {DSK}<home>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}<users>kaplan>local>medley3.5>working-medley>lispusers>GITFNS.;429)
+      :PREVIOUS-DATE "25-Jul-2022 15:14:26" {DSK}<home>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