Skip to content
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.

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

Initial changes to make GITFNS work with a personal GitHub repo. #1557

Draft
wants to merge 8 commits into
base: master
Choose a base branch
from
119 changes: 65 additions & 54 deletions lispusers/GITFNS
Original file line number Diff line number Diff line change
@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)

(FILECREATED " 1-Oct-2023 19:33:26" {WMEDLEY}<lispusers>GITFNS.;489 124166
(FILECREATED " 1-Feb-2024 20:51:51" {LU}GITFNS.;2 125030

:EDIT-BY rmk
:EDIT-BY "mth"

:CHANGES-TO (FNS GIT-MAKE-PROJECT)
:CHANGES-TO (FNS GIT-GET-PROJECT GIT-BRANCH-EXISTS? GIT-BRANCH-DIFF)

:PREVIOUS-DATE " 1-Oct-2023 19:27:42" {WMEDLEY}<lispusers>GITFNS.;488)
:PREVIOUS-DATE " 1-Oct-2023 19:33:26" {LU}GITFNS.;1)


(PRETTYCOMPRINT GITFNSCOMS)
Expand Down Expand Up @@ -288,32 +288,36 @@
PROJECTNAME))])

(GIT-GET-PROJECT
[LAMBDA (PROJECT FIELD NOERROR) (* ; "Edited 7-Jul-2022 11:25 by rmk")
[LAMBDA (PROJECT FIELD NOERROR) (* ; "Edited 1-Feb-2024 19:42 by mth")
(* ; "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")
(CL:WHEN (SETQ PROJECT (IF (TYPE? GIT-PROJECT PROJECT)
THEN PROJECT
ELSEIF (CDR (ASSOC (OR (U-CASE PROJECT)
(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)))
elseif NOERROR
then NIL
else (ERROR "NOT A GIT-PROJECT" PROJECT)))
(SELECTQ FIELD
(PROJECTNAME (FETCH PROJECTNAME OF PROJECT))
(PROJECTNAME (fetch PROJECTNAME of PROJECT))
(WHOST (FETCH WHOST OF PROJECT))
(GITHOST (FETCH GITHOST OF PROJECT))
(EXCLUSIONS (FETCH EXCLUSIONS OF PROJECT))
(DEFAULTSUBDIRS
(FETCH DEFAULTSUBDIRS OF PROJECT))
(CLONEPATH (FETCH CLONEPATH OF PROJECT))
(MAINBRANCH [OR (FETCH MAINBRANCH OF PROJECT)
(REPLACE MAINBRANCH OF PROJECT WITH (OR (GIT-BRANCH-EXISTS? 'origin/main
(MAINBRANCH [OR (fetch MAINBRANCH of PROJECT)
(replace MAINBRANCH of PROJECT with (OR (GIT-BRANCH-EXISTS? 'origin/main
T PROJECT)
(GIT-BRANCH-EXISTS?
'origin/master NIL PROJECT
])
'origin/master T PROJECT)
(GIT-BRANCH-EXISTS? 'local/main T
PROJECT)
(GIT-BRANCH-EXISTS?
'local/master NIL PROJECT])
PROJECT))])

(GIT-PUT-PROJECT-FIELD
Expand Down Expand Up @@ -1059,6 +1063,8 @@
(GIT-BRANCH-DIFF
[LAMBDA (BRANCH1 BRANCH2 PROJECT)

(* ;; "Edited 1-Feb-2024 20:49 by mth")

(* ;; "Edited 29-Sep-2022 10:52 by rmk")

(* ;; "Edited 12-Sep-2022 14:13 by rmk")
Expand Down Expand Up @@ -1089,7 +1095,11 @@

(SETQ RESULTFILE (GIT-COMMAND-TO-FILE (CONCAT
"git diff -C --find-copies-harder $(git merge-base "
BRANCH1 " " BRANCH2 ") " BRANCH2
(STRIPWHERE BRANCH1)
" "
(STRIPWHERE BRANCH2)
") "
(STRIPWHERE BRANCH2)
" --name-status")
PROJECT))
(SETQ ELINES NIL)
Expand Down Expand Up @@ -1351,18 +1361,19 @@
(SORT BRANCHES])

(GIT-BRANCH-EXISTS?
[LAMBDA (BRANCH NOERROR PROJECT EXCLUDEMERGED) (* ; "Edited 19-May-2022 10:10 by rmk")
[LAMBDA (BRANCH NOERROR PROJECT EXCLUDEMERGED) (* ; "Edited 1-Feb-2024 20:16 by mth")
(* ; "Edited 19-May-2022 10:10 by rmk")

(* ;; "Returns the canonical name of the branch (xxx or origin/xxx) depending on whether BRANCH is local/xxx or origin/xxx")

(IF (CAR (MEMB (MKATOM BRANCH)
(GIT-BRANCHES (IF (STRPOS "origin/" BRANCH 1 NIL T)
THEN 'REMOTE
ELSEIF (STRPOS "local/" BRANCH 1 NIL T)
THEN 'LOCAL)
(if (CAR (MEMB (MKATOM (STRIPWHERE BRANCH T))
(GIT-BRANCHES (if (STRPOS "origin/" BRANCH 1 NIL T)
then 'REMOTE
elseif (STRPOS "local/" BRANCH 1 NIL T)
then 'LOCAL)
PROJECT EXCLUDEMERGED)))
ELSEIF (NOT NOERROR)
THEN (ERROR "Unknown branch" BRANCH])
elseif (NOT NOERROR)
then (ERROR "Unknown branch" BRANCH])

(GIT-PICK-BRANCH
[LAMBDA (BRANCHES TITLE) (* ; "Edited 6-Jul-2023 22:31 by rmk")
Expand Down Expand Up @@ -2300,33 +2311,33 @@

(PUTPROPS GITFNS FILETYPE :TCOMPL)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (4081 20660 (GIT-CLONEP 4091 . 5419) (GIT-INIT 5421 . 6051) (GIT-MAKE-PROJECT 6053 .
13718) (GIT-GET-PROJECT 13720 . 15645) (GIT-PUT-PROJECT-FIELD 15647 . 17288) (GIT-PROJECT-PATH 17290
. 18334) (FIND-ANCESTOR-DIRECTORY 18336 . 18685) (GIT-FIND-CLONE 18687 . 19768) (GIT-MAINBRANCH 19770
. 20165) (GIT-MAINBRANCH? 20167 . 20658)) (26068 28195 (PRC-COMMAND 26078 . 28193)) (28251 31039 (
ALLSUBDIRS 28261 . 29547) (MEDLEYSUBDIRS 29549 . 30242) (GITSUBDIRS 30244 . 31037)) (31040 35830 (
TOGIT 31050 . 32456) (FROMGIT 32458 . 33439) (GIT-DELETE-FILE 33441 . 34287) (MYMEDLEY-DELETE-FILES
34289 . 35828)) (35831 38834 (MYMEDLEYSUBDIR 35841 . 36297) (GITSUBDIR 36299 . 36742) (STRIPDIR 36744
. 37115) (STRIPHOST 37117 . 37357) (STRIPNAME 37359 . 38112) (STRIPWHERE 38114 . 38832)) (38835 40737
(GFILE4MFILE 38845 . 39208) (MFILE4GFILE 39210 . 39779) (GIT-REPO-FILENAME 39781 . 40735)) (40786
52616 (GIT-COMMIT 40796 . 41622) (GIT-PUSH 41624 . 42268) (GIT-PULL 42270 . 42882) (GIT-APPROVAL 42884
. 43233) (GIT-GET-FILE 43235 . 45200) (GIT-FILE-EXISTS? 45202 . 45476) (GIT-REMOTE-UPDATE 45478 .
46202) (GIT-REMOTE-ADD 46204 . 46511) (GIT-FILE-DATE 46513 . 47444) (GIT-FILE-HISTORY 47446 . 49380) (
GIT-PRINT-FILE-HISTORY 49382 . 50432) (GIT-FETCH 50434 . 50606) (GIT-PR-BRANCHES 50608 . 52614)) (
52646 63239 (GIT-BRANCH-DIFF 52656 . 58996) (GIT-COMMIT-DIFFS 58998 . 59551) (GIT-BRANCH-RELATIONS
59553 . 63237)) (63284 76387 (GIT-BRANCH-NUM 63294 . 63867) (GIT-CHECKOUT 63869 . 64928) (
GIT-WHICH-BRANCH 64930 . 65228) (GIT-MAKE-BRANCH 65230 . 67443) (GIT-BRANCHES 67445 . 69713) (
GIT-BRANCH-EXISTS? 69715 . 70419) (GIT-PICK-BRANCH 70421 . 70911) (GIT-BRANCH-MENU 70913 . 71616) (
GIT-PULL-REQUESTS 71618 . 73764) (GIT-SHORT-BRANCH-NAME 73766 . 74057) (GIT-LONG-NAME 74059 . 74376) (
GIT-PRC-BRANCHES 74378 . 76385)) (76417 79752 (GIT-MY-CURRENT-BRANCH 76427 . 76797) (GIT-MY-BRANCHP
76799 . 77304) (GIT-MY-NEXT-BRANCH 77306 . 77800) (GIT-MY-BRANCHES 77802 . 79750)) (79798 83750 (
GIT-ADD-WORKTREE 79808 . 81292) (GIT-REMOVE-WORKTREE 81294 . 82224) (GIT-LIST-WORKTREES 82226 . 83030)
(WORKTREEDIR 83032 . 83748)) (83798 116000 (GIT-GET-DIFFERENT-FILES 83808 . 90232) (
GIT-BRANCHES-COMPARE-DIRECTORIES 90234 . 96585) (GIT-WORKING-COMPARE-DIRECTORIES 96587 . 101983) (
GIT-COMPARE-WORKTREE 101985 . 105963) (GITCDOBJBUTTONFN 105965 . 110455) (GIT-CD-LABELFN 110457 .
111539) (GIT-CD-MENUFN 111541 . 113981) (GIT-WORKING-COMPARE-FILES 113983 . 114603) (
GIT-BRANCHES-COMPARE-FILES 114605 . 115769) (GIT-PR-COMPARE 115771 . 115998)) (116070 124099 (CDGITDIR
116080 . 116767) (GIT-COMMAND 116769 . 118327) (GITORIGIN 118329 . 119026) (GIT-INITIALS 119028 .
119332) (GIT-COMMAND-TO-FILE 119334 . 122823) (GIT-RESULT-TO-LINES 122825 . 123432) (STRIPLOCAL 123434
. 124097)))))
(FILEMAP (NIL (4081 21076 (GIT-CLONEP 4091 . 5419) (GIT-INIT 5421 . 6051) (GIT-MAKE-PROJECT 6053 .
13718) (GIT-GET-PROJECT 13720 . 16061) (GIT-PUT-PROJECT-FIELD 16063 . 17704) (GIT-PROJECT-PATH 17706
. 18750) (FIND-ANCESTOR-DIRECTORY 18752 . 19101) (GIT-FIND-CLONE 19103 . 20184) (GIT-MAINBRANCH 20186
. 20581) (GIT-MAINBRANCH? 20583 . 21074)) (26484 28611 (PRC-COMMAND 26494 . 28609)) (28667 31455 (
ALLSUBDIRS 28677 . 29963) (MEDLEYSUBDIRS 29965 . 30658) (GITSUBDIRS 30660 . 31453)) (31456 36246 (
TOGIT 31466 . 32872) (FROMGIT 32874 . 33855) (GIT-DELETE-FILE 33857 . 34703) (MYMEDLEY-DELETE-FILES
34705 . 36244)) (36247 39250 (MYMEDLEYSUBDIR 36257 . 36713) (GITSUBDIR 36715 . 37158) (STRIPDIR 37160
. 37531) (STRIPHOST 37533 . 37773) (STRIPNAME 37775 . 38528) (STRIPWHERE 38530 . 39248)) (39251 41153
(GFILE4MFILE 39261 . 39624) (MFILE4GFILE 39626 . 40195) (GIT-REPO-FILENAME 40197 . 41151)) (41202
53032 (GIT-COMMIT 41212 . 42038) (GIT-PUSH 42040 . 42684) (GIT-PULL 42686 . 43298) (GIT-APPROVAL 43300
. 43649) (GIT-GET-FILE 43651 . 45616) (GIT-FILE-EXISTS? 45618 . 45892) (GIT-REMOTE-UPDATE 45894 .
46618) (GIT-REMOTE-ADD 46620 . 46927) (GIT-FILE-DATE 46929 . 47860) (GIT-FILE-HISTORY 47862 . 49796) (
GIT-PRINT-FILE-HISTORY 49798 . 50848) (GIT-FETCH 50850 . 51022) (GIT-PR-BRANCHES 51024 . 53030)) (
53062 63975 (GIT-BRANCH-DIFF 53072 . 59732) (GIT-COMMIT-DIFFS 59734 . 60287) (GIT-BRANCH-RELATIONS
60289 . 63973)) (64020 77251 (GIT-BRANCH-NUM 64030 . 64603) (GIT-CHECKOUT 64605 . 65664) (
GIT-WHICH-BRANCH 65666 . 65964) (GIT-MAKE-BRANCH 65966 . 68179) (GIT-BRANCHES 68181 . 70449) (
GIT-BRANCH-EXISTS? 70451 . 71283) (GIT-PICK-BRANCH 71285 . 71775) (GIT-BRANCH-MENU 71777 . 72480) (
GIT-PULL-REQUESTS 72482 . 74628) (GIT-SHORT-BRANCH-NAME 74630 . 74921) (GIT-LONG-NAME 74923 . 75240) (
GIT-PRC-BRANCHES 75242 . 77249)) (77281 80616 (GIT-MY-CURRENT-BRANCH 77291 . 77661) (GIT-MY-BRANCHP
77663 . 78168) (GIT-MY-NEXT-BRANCH 78170 . 78664) (GIT-MY-BRANCHES 78666 . 80614)) (80662 84614 (
GIT-ADD-WORKTREE 80672 . 82156) (GIT-REMOVE-WORKTREE 82158 . 83088) (GIT-LIST-WORKTREES 83090 . 83894)
(WORKTREEDIR 83896 . 84612)) (84662 116864 (GIT-GET-DIFFERENT-FILES 84672 . 91096) (
GIT-BRANCHES-COMPARE-DIRECTORIES 91098 . 97449) (GIT-WORKING-COMPARE-DIRECTORIES 97451 . 102847) (
GIT-COMPARE-WORKTREE 102849 . 106827) (GITCDOBJBUTTONFN 106829 . 111319) (GIT-CD-LABELFN 111321 .
112403) (GIT-CD-MENUFN 112405 . 114845) (GIT-WORKING-COMPARE-FILES 114847 . 115467) (
GIT-BRANCHES-COMPARE-FILES 115469 . 116633) (GIT-PR-COMPARE 116635 . 116862)) (116934 124963 (CDGITDIR
116944 . 117631) (GIT-COMMAND 117633 . 119191) (GITORIGIN 119193 . 119890) (GIT-INITIALS 119892 .
120196) (GIT-COMMAND-TO-FILE 120198 . 123687) (GIT-RESULT-TO-LINES 123689 . 124296) (STRIPLOCAL 124298
. 124961)))))
STOP
Binary file modified lispusers/GITFNS.LCOM
Binary file not shown.