Skip to content

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

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Aug 11, 2022
Merged

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

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
146 changes: 82 additions & 64 deletions lispusers/GITFNS
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -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)
Expand All @@ -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))

(* ;; "")

Expand Down Expand Up @@ -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")
Expand All @@ -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)
Expand All @@ -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
Expand Down Expand Up @@ -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)
Expand All @@ -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))])

Expand Down Expand Up @@ -367,17 +384,18 @@

(RPAQ? GIT-DEFAULT-PROJECT 'MEDLEY)

(RPAQ? GIT-PROJECTS NIL)
(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)))

(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/))
(RPAQ? GIT-PROJECTS NIL)

(GIT-MAKE-PROJECT 'LOOPS T T)
(GIT-INIT)

(GIT-MAKE-PROJECT 'TEST T T)
(ADDTOVAR AROUNDEXITFNS GIT-INIT)



Expand Down Expand Up @@ -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
Binary file modified lispusers/GITFNS.LCOM
View file
Open in desktop
Binary file not shown.