Skip to content

Commit f44b96e

Browse files
authored
Rmk22 gitfns ignores other owners (#1713)
* GITFNS: prc ignores PRs from other owners The menu just includes Interlisp PR's. Fixing it to deal with other owners will take more work. * JSON: JSON-GET takes a list of attributes A convenience for accessing objects embedded in objects * GITFNS: a minor cleanup * Remove JSON-GET left over * Put the git commands to install remotes in comments So we don't have to rediscover them when we decide to fix prc to deal with this issue.
1 parent e9bea32 commit f44b96e

File tree

4 files changed

+117
-83
lines changed

4 files changed

+117
-83
lines changed

lispusers/GITFNS

Lines changed: 105 additions & 71 deletions
Original file line numberDiff line numberDiff line change
@@ -1,13 +1,12 @@
11
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
22

3-
(FILECREATED " 2-May-2024 23:35:36" {WMEDLEY}<lispusers>GITFNS.;511 129269
3+
(FILECREATED "20-May-2024 22:13:04" {WMEDLEY}<lispusers>GITFNS.;530 131382
44

55
:EDIT-BY rmk
66

7-
:CHANGES-TO (FNS GIT-PUSH GIT-PULL GIT-GET-FILE GIT-FILE-DATE GIT-BRANCH-DIFF GIT-COMMIT-DIFFS
8-
GIT-CHECKOUT GIT-MAKE-BRANCH GIT-BRANCHES GIT-BRANCH-EXISTS? GIT-ADD-WORKTREE)
7+
:CHANGES-TO (FNS GIT-PULL-REQUESTS)
98

10-
:PREVIOUS-DATE " 2-May-2024 22:57:39" {WMEDLEY}<lispusers>GITFNS.;510)
9+
:PREVIOUS-DATE "13-May-2024 19:31:18" {WMEDLEY}<lispusers>GITFNS.;529)
1110

1211

1312
(PRETTYCOMPRINT GITFNSCOMS)
@@ -404,7 +403,7 @@
404403

405404
(TYPERECORD GIT-PROJECT (PROJECTNAME GITHOST WHOST EXCLUSIONS DEFAULTSUBDIRS CLONEPATH MAINBRANCH))
406405

407-
(RECORD PULLREQUEST (PRNUMBER PRDESCRIPTION PRNAME PRSTATUS PRPROJECT))
406+
(RECORD PULLREQUEST (PRNUMBER PRDESCRIPTION PRNAME PRSTATUS PRPROJECT PRURL PRLOGIN))
408407
)
409408
)
410409

@@ -536,7 +535,8 @@
536535
(DEFINEQ
537536

538537
(PRC-COMMAND
539-
[LAMBDA (REMOTEBRANCH DRAFTS PROJECT) (* ; "Edited 2-May-2024 11:44 by rmk")
538+
[LAMBDA (REMOTEBRANCH DRAFTS PROJECT) (* ; "Edited 13-May-2024 18:49 by rmk")
539+
(* ; "Edited 2-May-2024 11:44 by rmk")
540540
(* ; "Edited 1-Apr-2024 20:24 by rmk")
541541
(* ; "Edited 28-Jul-2023 09:03 by rmk")
542542

@@ -566,22 +566,30 @@
566566

567567
(SETQ PRS (GIT-PULL-REQUESTS (NEQ 'NODRAFTS DRAFTS)
568568
PROJECT))
569-
(CL:WHEN (AND REMOTEBRANCH (NEQ REMOTEBRANCH 'PinMenu))
570569

571-
(* ;; "Filter by the REMOTEBRANCH string")
572-
573-
(SETQ PRS (for PR in PRS when (OR (STRPOS REMOTEBRANCH (fetch PRDESCRIPTION of PR)
574-
NIL NIL NIL NIL FILEDIRCASEARRAY)
575-
(STRPOS REMOTEBRANCH (fetch PRNAME of PR)
576-
NIL NIL NIL NIL FILEDIRCASEARRAY)) collect
577-
PR)))
570+
(* ;; "Filter by REMOTEBRANCH properties")
571+
572+
(SETQ PRS (for PR FOUND in PRS
573+
when (if (STRING-EQUAL "Interlisp" (fetch PRLOGIN of PR))
574+
then (OR (NULL REMOTEBRANCH)
575+
(STRPOS REMOTEBRANCH (fetch PRDESCRIPTION of PR)
576+
NIL NIL NIL NIL FILEDIRCASEARRAY)
577+
(STRPOS REMOTEBRANCH (fetch PRNAME of PR)
578+
NIL NIL NIL NIL FILEDIRCASEARRAY))
579+
else (CL:UNLESS FOUND
580+
(SETQ FOUND T)
581+
(PRINTOUT T "Ignored because not owned by Interlisp: " T))
582+
(PRINTOUT T 3 (fetch PRDESCRIPTION of PR)
583+
" ("
584+
(fetch PRLOGIN of PR)
585+
")" T)
586+
NIL) collect PR))
578587
(IF PRS
579588
THEN (if (CDR PRS)
580589
then (SETQ MENUWINDOW (ADDMENU (GIT-BRANCH-MENU (GIT-PRC-BRANCHES DRAFTS
581590
PROJECT PRS)
582591
(CONCAT (LENGTH PRS)
583-
" pull requests")
584-
NIL PROJECT)
592+
" pull requests"))
585593
NIL NIL T))
586594

587595
(* ;; "Position the new menu just under the current TTY window, to keep it out of the way of the comparison windows. If we have menus open for other projects, those probably should be pushed down to make room for the new menu, and moved up when a higher menu is closed. An edge case that is not worth the effort. ")
@@ -1408,48 +1416,60 @@
14081416
WHENSELECTEDFN _ (FUNCTION GIT-BRANCH-WHENSELECTEDFN)))])
14091417

14101418
(GIT-BRANCH-WHENSELECTEDFN
1411-
[LAMBDA (ITEM) (* ; "Edited 1-May-2024 18:17 by rmk")
1419+
[LAMBDA (ITEM) (* ; "Edited 11-May-2024 11:05 by rmk")
1420+
(* ; "Edited 1-May-2024 18:17 by rmk")
14121421
(* ; "CAR is git key, 4th is project")
14131422

14141423
(* ;; "This executes the comparison in the current TTY window, either by stuffing the command there or by evaluating there. There probably should be a check to make sure that the TTY is in fact an executive--if not, maybe this should be a no-op. Better than getting the comparison form in the middle of anther SEDIT or TEDIT.")
14151424

14161425
(* ;; "This could also execute in the mouse process, where the menu is clicked. But in that case a terminal window pops up with the header lines of the compare, and that seems a nuisance.")
14171426

1418-
(if T
1419-
then
1420-
(* ;; "The COPYINSERT causes the compare to run in the TTY process, by stuffing the characters in the input line. Somehow it executes even if the parens are not there, but that looks funny. But it also works if I stuff the parens on both sides.")
1421-
1422-
(BKSYSBUF '%()
1423-
[COPYINSERT `(GIT-PR-COMPARE ,(CADR ITEM)
1424-
',(CADR (CDDDR ITEM]
1425-
(BKSYSBUF '%))
1426-
else
1427-
(* ;; "This puts the print out after the next event number in the TTY window, unfortunately. We go to the default font so we don't get TTYIN's input bold for this.")
1428-
1429-
(PROCESS.EVAL (TTY.PROCESS)
1430-
`(RESETLST
1431-
[RESETSAVE (DSPFONT DEFAULTFONT T)
1432-
'(PROGN (DSPFONT OLDVALUE T])])
1427+
(LET [(PR (CAR (LAST ITEM]
1428+
(if [AND NIL (PROGN (GETMOUSESTATE)
1429+
(EQ 'MIDDLE (DECODEBUTTONS]
1430+
then (LET [(POS (ADD1 (STRPOS "#" (CAR ITEM]
1431+
(ShellBrowse (fetch PRURL of PR)))
1432+
elseif (PROGN T)
1433+
then
1434+
(* ;; "PROGN because DWIM is screwed up")
1435+
1436+
(* ;; "The COPYINSERT causes the compare to run in the TTY process, by stuffing the characters in the input line. Somehow it executes even if the parens are not there, but that looks funny. But it also works if I stuff the parens on both sides.")
1437+
1438+
(BKSYSBUF '%()
1439+
[COPYINSERT `(GIT-PR-COMPARE ,(CADR ITEM)
1440+
',(fetch PRPROJECT of PR]
1441+
(BKSYSBUF '%))
1442+
else
1443+
(* ;; "This puts the print out after the next event number in the TTY window, unfortunately. We go to the default font so we don't get TTYIN's input bold for this.")
1444+
1445+
(PROCESS.EVAL (TTY.PROCESS)
1446+
`(RESETLST
1447+
[RESETSAVE (DSPFONT DEFAULTFONT T)
1448+
'(PROGN (DSPFONT OLDVALUE T])])
14331449

14341450
(GIT-PULL-REQUESTS
1435-
[LAMBDA (INCLUDEDRAFTS PROJECT) (* ; "Edited 1-May-2024 09:23 by rmk")
1451+
[LAMBDA (INCLUDEDRAFTS PROJECT) (* ; "Edited 20-May-2024 22:12 by rmk")
1452+
(* ; "Edited 13-May-2024 18:59 by rmk")
1453+
(* ; "Edited 11-May-2024 10:51 by rmk")
1454+
(* ; "Edited 1-May-2024 09:23 by rmk")
14361455
(* ; "Edited 8-Aug-2022 13:12 by rmk")
14371456
(* ; "Edited 4-Aug-2022 19:01 by rmk")
14381457
(* ; "Edited 17-Jul-2022 11:12 by rmk")
1439-
(* ; "Edited 9-May-2022 16:54 by rmk")
1440-
(* ; "Edited 25-Feb-2022 09:26 by rmk")
1458+
(* ; "Edited 9-May-2022 16:54 by rmk")
1459+
1460+
(* ;; "Returns a list of PULLREQUEST records, one for each pull request")
1461+
 (* ; "Edited 25-Feb-2022 09:26 by rmk")
14411462
(CL:UNLESS (EQ 0 (PROCESS-COMMAND "command -v gh"))
14421463
(ERROR "gh must be installed in order to enumerate pull requests:"))
1443-
(LET [(JPARSE (JSON-PARSE (CAR (GIT-COMMAND
1444-
"gh pr list --json number,headRefName,title,isDraft,reviewDecision"
1464+
(LET [(JPARSE (JSON-PARSE (CAR (GIT-COMMAND "gh pr list --json number,headRefName,title,isDraft,reviewDecision,url,headRepository,headRepositoryOwner"
14451465
T NIL PROJECT]
14461466
(FOR JSOBJ DRAFT PR IN (SELECTQ (CAR JPARSE)
14471467
(ARRAY (CDR JPARSE))
14481468
(OBJECT JPARSE)
14491469
(ERROR "UNRECOGNIZED PRC LIST FROM GIT" JPARSE))
14501470
EACHTIME [SETQ DRAFT (EQ 'true (JSON-GET JSOBJ 'isDraft] WHEN (OR INCLUDEDRAFTS
14511471
(NOT DRAFT))
1452-
COLLECT (SETQ PR (CREATE PULLREQUEST
1472+
COLLECT [SETQ PR (CREATE PULLREQUEST
14531473
PRNUMBER _ (JSON-GET JSOBJ 'number)
14541474
PRNAME _ (JSON-GET JSOBJ 'headRefName)
14551475
PRDESCRIPTION _ (JSON-GET JSOBJ 'title)
@@ -1459,8 +1479,19 @@
14591479
(JSON-GET JSOBJ 'reviewDecision))
14601480
" "
14611481
'A))
1462-
PRPROJECT _ PROJECT))
1482+
PRPROJECT _ PROJECT
1483+
PRURL _ (JSON-GET JSOBJ 'url)
1484+
PRLOGIN _ (JSON-GET JSOBJ '(headRepositoryOwner login]
14631485
(CL:WHEN (STRPOS ":" (fetch (PULLREQUEST PRNAME) of PR))
1486+
1487+
(* ;; "From Nick: Git commands to bring install and deal with the remotes:")
1488+
1489+
(* ;; "git remote add [PRLOGIN] https://github.com/[PRLOGIN]/[PROJECT]")
1490+
1491+
(* ;; " (project in lower-case)")
1492+
1493+
(* ;; "git remote update [PRLOGIN]")
1494+
14641495
(PRINTOUT T "Ignoring PR for forked repo %%%" #" (JSON-GET JSOBJ 'number)
14651496
" "
14661497
(fetch (PULLREQUEST PRNAME) of PR)
@@ -1484,7 +1515,9 @@
14841515
(FIND B IN (GIT-BRANCHES WHERE PROJECT EXCLUDEMERGED) SUCHTHAT (STRPOS BRANCH B])
14851516

14861517
(GIT-PRC-BRANCHES
1487-
[LAMBDA (DRAFT PROJECT PRS) (* ; "Edited 1-May-2024 21:06 by rmk")
1518+
[LAMBDA (DRAFT PROJECT PRS) (* ; "Edited 13-May-2024 19:30 by rmk")
1519+
(* ; "Edited 11-May-2024 10:52 by rmk")
1520+
(* ; "Edited 1-May-2024 21:06 by rmk")
14881521
(* ; "Edited 1-Apr-2024 17:09 by rmk")
14891522
(* ; "Edited 8-Aug-2022 18:15 by rmk")
14901523
(* ; "Edited 4-Aug-2022 18:55 by rmk")
@@ -1496,7 +1529,8 @@
14961529
(CL:UNLESS PRS
14971530
(SETQ PRS (GIT-PULL-REQUESTS T PROJECT)))
14981531
(CL:WHEN PRS
1499-
(LET ((RELATIONS (GIT-BRANCH-RELATIONS (FOR PR IN PRS COLLECT (GITORIGIN (CADDR PR)))
1532+
(LET ((RELATIONS (GIT-BRANCH-RELATIONS (FOR PR IN PRS
1533+
COLLECT (GITORIGIN (fetch PRNAME of PR)))
15001534
NIL T PROJECT)))
15011535
(SORT (FOR PR REL LABEL PRNAME STATUS (SUPERSETS _ (CAR RELATIONS))
15021536
(EQUALS _ (CADR RELATIONS)) IN PRS
@@ -1517,7 +1551,7 @@
15171551
(CONCAT " " STATUS " #" (FETCH PRNUMBER OF PR)
15181552
" "
15191553
(FETCH PRDESCRIPTION OF PR))
1520-
NIL PROJECT))
1554+
NIL PR))
15211555
T)))])
15221556
)
15231557

@@ -2368,33 +2402,33 @@
23682402

23692403
(PUTPROPS GITFNS FILETYPE :TCOMPL)
23702404
(DECLARE%: DONTCOPY
2371-
(FILEMAP (NIL (4348 20927 (GIT-CLONEP 4358 . 5686) (GIT-INIT 5688 . 6318) (GIT-MAKE-PROJECT 6320 .
2372-
13985) (GIT-GET-PROJECT 13987 . 15912) (GIT-PUT-PROJECT-FIELD 15914 . 17555) (GIT-PROJECT-PATH 17557
2373-
. 18601) (FIND-ANCESTOR-DIRECTORY 18603 . 18952) (GIT-FIND-CLONE 18954 . 20035) (GIT-MAINBRANCH 20037
2374-
. 20432) (GIT-MAINBRANCH? 20434 . 20925)) (26376 30458 (PRC-COMMAND 26386 . 30456)) (30514 33302 (
2375-
ALLSUBDIRS 30524 . 31810) (MEDLEYSUBDIRS 31812 . 32505) (GITSUBDIRS 32507 . 33300)) (33303 38093 (
2376-
TOGIT 33313 . 34719) (FROMGIT 34721 . 35702) (GIT-DELETE-FILE 35704 . 36550) (MYMEDLEY-DELETE-FILES
2377-
36552 . 38091)) (38094 41097 (MYMEDLEYSUBDIR 38104 . 38560) (GITSUBDIR 38562 . 39005) (STRIPDIR 39007
2378-
. 39378) (STRIPHOST 39380 . 39620) (STRIPNAME 39622 . 40375) (STRIPWHERE 40377 . 41095)) (41098 43000
2379-
(GFILE4MFILE 41108 . 41471) (MFILE4GFILE 41473 . 42042) (GIT-REPO-FILENAME 42044 . 42998)) (43049
2380-
53300 (GIT-COMMIT 43059 . 43885) (GIT-PUSH 43887 . 44647) (GIT-PULL 44649 . 45401) (GIT-APPROVAL 45403
2381-
. 45752) (GIT-GET-FILE 45754 . 47776) (GIT-FILE-EXISTS? 47778 . 48052) (GIT-REMOTE-UPDATE 48054 .
2382-
48778) (GIT-REMOTE-ADD 48780 . 49087) (GIT-FILE-DATE 49089 . 50136) (GIT-FILE-HISTORY 50138 . 52072) (
2383-
GIT-PRINT-FILE-HISTORY 52074 . 53124) (GIT-FETCH 53126 . 53298)) (53330 64103 (GIT-BRANCH-DIFF 53340
2384-
. 59740) (GIT-COMMIT-DIFFS 59742 . 60415) (GIT-BRANCH-RELATIONS 60417 . 64101)) (64148 80865 (
2385-
GIT-BRANCH-NUM 64158 . 64731) (GIT-CHECKOUT 64733 . 65908) (GIT-WHICH-BRANCH 65910 . 66208) (
2386-
GIT-MAKE-BRANCH 66210 . 68539) (GIT-BRANCHES 68541 . 71031) (GIT-BRANCH-EXISTS? 71033 . 71904) (
2387-
GIT-PICK-BRANCH 71906 . 72396) (GIT-BRANCH-MENU 72398 . 73279) (GIT-BRANCH-WHENSELECTEDFN 73281 .
2388-
74916) (GIT-PULL-REQUESTS 74918 . 77527) (GIT-SHORT-BRANCH-NAME 77529 . 77820) (GIT-LONG-NAME 77822 .
2389-
78139) (GIT-PRC-BRANCHES 78141 . 80863)) (80895 84230 (GIT-MY-CURRENT-BRANCH 80905 . 81275) (
2390-
GIT-MY-BRANCHP 81277 . 81782) (GIT-MY-NEXT-BRANCH 81784 . 82278) (GIT-MY-BRANCHES 82280 . 84228)) (
2391-
84276 88351 (GIT-ADD-WORKTREE 84286 . 85893) (GIT-REMOVE-WORKTREE 85895 . 86825) (GIT-LIST-WORKTREES
2392-
86827 . 87631) (WORKTREEDIR 87633 . 88349)) (88399 121103 (GIT-GET-DIFFERENT-FILES 88409 . 94833) (
2393-
GIT-BRANCHES-COMPARE-DIRECTORIES 94835 . 101688) (GIT-WORKING-COMPARE-DIRECTORIES 101690 . 107086) (
2394-
GIT-COMPARE-WORKTREE 107088 . 111066) (GITCDOBJBUTTONFN 111068 . 115558) (GIT-CD-LABELFN 115560 .
2395-
116642) (GIT-CD-MENUFN 116644 . 119084) (GIT-WORKING-COMPARE-FILES 119086 . 119706) (
2396-
GIT-BRANCHES-COMPARE-FILES 119708 . 120872) (GIT-PR-COMPARE 120874 . 121101)) (121173 129202 (CDGITDIR
2397-
121183 . 121870) (GIT-COMMAND 121872 . 123430) (GITORIGIN 123432 . 124129) (GIT-INITIALS 124131 .
2398-
124435) (GIT-COMMAND-TO-FILE 124437 . 127926) (GIT-RESULT-TO-LINES 127928 . 128535) (STRIPLOCAL 128537
2399-
. 129200)))))
2405+
(FILEMAP (NIL (4187 20766 (GIT-CLONEP 4197 . 5525) (GIT-INIT 5527 . 6157) (GIT-MAKE-PROJECT 6159 .
2406+
13824) (GIT-GET-PROJECT 13826 . 15751) (GIT-PUT-PROJECT-FIELD 15753 . 17394) (GIT-PROJECT-PATH 17396
2407+
. 18440) (FIND-ANCESTOR-DIRECTORY 18442 . 18791) (GIT-FIND-CLONE 18793 . 19874) (GIT-MAINBRANCH 19876
2408+
. 20271) (GIT-MAINBRANCH? 20273 . 20764)) (26229 30851 (PRC-COMMAND 26239 . 30849)) (30907 33695 (
2409+
ALLSUBDIRS 30917 . 32203) (MEDLEYSUBDIRS 32205 . 32898) (GITSUBDIRS 32900 . 33693)) (33696 38486 (
2410+
TOGIT 33706 . 35112) (FROMGIT 35114 . 36095) (GIT-DELETE-FILE 36097 . 36943) (MYMEDLEY-DELETE-FILES
2411+
36945 . 38484)) (38487 41490 (MYMEDLEYSUBDIR 38497 . 38953) (GITSUBDIR 38955 . 39398) (STRIPDIR 39400
2412+
. 39771) (STRIPHOST 39773 . 40013) (STRIPNAME 40015 . 40768) (STRIPWHERE 40770 . 41488)) (41491 43393
2413+
(GFILE4MFILE 41501 . 41864) (MFILE4GFILE 41866 . 42435) (GIT-REPO-FILENAME 42437 . 43391)) (43442
2414+
53693 (GIT-COMMIT 43452 . 44278) (GIT-PUSH 44280 . 45040) (GIT-PULL 45042 . 45794) (GIT-APPROVAL 45796
2415+
. 46145) (GIT-GET-FILE 46147 . 48169) (GIT-FILE-EXISTS? 48171 . 48445) (GIT-REMOTE-UPDATE 48447 .
2416+
49171) (GIT-REMOTE-ADD 49173 . 49480) (GIT-FILE-DATE 49482 . 50529) (GIT-FILE-HISTORY 50531 . 52465) (
2417+
GIT-PRINT-FILE-HISTORY 52467 . 53517) (GIT-FETCH 53519 . 53691)) (53723 64496 (GIT-BRANCH-DIFF 53733
2418+
. 60133) (GIT-COMMIT-DIFFS 60135 . 60808) (GIT-BRANCH-RELATIONS 60810 . 64494)) (64541 82978 (
2419+
GIT-BRANCH-NUM 64551 . 65124) (GIT-CHECKOUT 65126 . 66301) (GIT-WHICH-BRANCH 66303 . 66601) (
2420+
GIT-MAKE-BRANCH 66603 . 68932) (GIT-BRANCHES 68934 . 71424) (GIT-BRANCH-EXISTS? 71426 . 72297) (
2421+
GIT-PICK-BRANCH 72299 . 72789) (GIT-BRANCH-MENU 72791 . 73672) (GIT-BRANCH-WHENSELECTEDFN 73674 .
2422+
75839) (GIT-PULL-REQUESTS 75841 . 79359) (GIT-SHORT-BRANCH-NAME 79361 . 79652) (GIT-LONG-NAME 79654 .
2423+
79971) (GIT-PRC-BRANCHES 79973 . 82976)) (83008 86343 (GIT-MY-CURRENT-BRANCH 83018 . 83388) (
2424+
GIT-MY-BRANCHP 83390 . 83895) (GIT-MY-NEXT-BRANCH 83897 . 84391) (GIT-MY-BRANCHES 84393 . 86341)) (
2425+
86389 90464 (GIT-ADD-WORKTREE 86399 . 88006) (GIT-REMOVE-WORKTREE 88008 . 88938) (GIT-LIST-WORKTREES
2426+
88940 . 89744) (WORKTREEDIR 89746 . 90462)) (90512 123216 (GIT-GET-DIFFERENT-FILES 90522 . 96946) (
2427+
GIT-BRANCHES-COMPARE-DIRECTORIES 96948 . 103801) (GIT-WORKING-COMPARE-DIRECTORIES 103803 . 109199) (
2428+
GIT-COMPARE-WORKTREE 109201 . 113179) (GITCDOBJBUTTONFN 113181 . 117671) (GIT-CD-LABELFN 117673 .
2429+
118755) (GIT-CD-MENUFN 118757 . 121197) (GIT-WORKING-COMPARE-FILES 121199 . 121819) (
2430+
GIT-BRANCHES-COMPARE-FILES 121821 . 122985) (GIT-PR-COMPARE 122987 . 123214)) (123286 131315 (CDGITDIR
2431+
123296 . 123983) (GIT-COMMAND 123985 . 125543) (GITORIGIN 125545 . 126242) (GIT-INITIALS 126244 .
2432+
126548) (GIT-COMMAND-TO-FILE 126550 . 130039) (GIT-RESULT-TO-LINES 130041 . 130648) (STRIPLOCAL 130650
2433+
. 131313)))))
24002434
STOP

lispusers/GITFNS.LCOM

173 Bytes
Binary file not shown.

0 commit comments

Comments
 (0)