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.
This commit is contained in:
rmkaplan
GitHub
214
lispusers/GITFNS
214
lispusers/GITFNS
@@ -1,12 +1,10 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 5-Feb-2023 12:43:27"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>GITFNS.;467 117168
|
||||
(FILECREATED "30-Mar-2023 09:08:48" {WMEDLEY}<lispusers>GITFNS.;469 119763
|
||||
|
||||
:CHANGES-TO (FNS GIT-MAKE-PROJECT)
|
||||
|
||||
:PREVIOUS-DATE " 1-Feb-2023 18:54:25"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>GITFNS.;466)
|
||||
:PREVIOUS-DATE "11-Mar-2023 23:12:35" {WMEDLEY}<lispusers>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
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user