From 3276822c19460e9a04abd19bb43ee7c6c42473da Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Mon, 22 Sep 2025 12:57:01 -0700 Subject: [PATCH] GITFNS uses {DSK}/tmp/ instead of {CORE} for PR file comparison Doesn't use Medley memory. --- lispusers/GITFNS | 95 ++++++++++++++++++++++-------------------- lispusers/GITFNS.LCOM | Bin 51441 -> 51504 bytes 2 files changed, 49 insertions(+), 46 deletions(-) diff --git a/lispusers/GITFNS b/lispusers/GITFNS index ba121bb7..8b0dd55b 100644 --- a/lispusers/GITFNS +++ b/lispusers/GITFNS @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 9-May-2025 11:39:55" {WMEDLEY}GITFNS.;545 134412 +(FILECREATED "22-Sep-2025 12:52:41" {WMEDLEY}GITFNS.;550 134632 :EDIT-BY rmk - :CHANGES-TO (FNS GIT-PULL-REQUESTS) + :CHANGES-TO (FNS GIT-GET-FILE GIT-GET-DIFFERENT-FILES) - :PREVIOUS-DATE " 5-May-2025 22:04:15" {WMEDLEY}GITFNS.;544) + :PREVIOUS-DATE " 9-May-2025 11:39:55" {WMEDLEY}GITFNS.;545) (PRETTYCOMPRINT GITFNSCOMS) @@ -1733,6 +1733,8 @@ [LAMBDA (BRANCH1 BRANCH2 DIR1 DIR2 PROJECT) (DECLARE (USEDFREE FROMGITN)) + (* ;; "Edited 22-Sep-2025 12:48 by rmk") + (* ;; "Edited 12-Sep-2022 14:58 by rmk") (* ;; "Edited 21-May-2022 23:38 by rmk") @@ -1745,23 +1747,24 @@ (SETQ BRANCH1 (GIT-BRANCH-EXISTS? BRANCH1 NIL PROJECT)) (SETQ BRANCH2 (GIT-BRANCH-EXISTS? BRANCH2 NIL PROJECT)) (LET - (MAPPINGS FROMGIT (DIFFS (GIT-BRANCH-DIFF BRANCH1 BRANCH2 PROJECT))) + (MAPPINGS FROMGIT FROMGITDIR PRNAME (DIFFS (GIT-BRANCH-DIFF BRANCH1 BRANCH2 PROJECT))) (CL:WHEN DIFFS - (SETQ FROMGIT (PACK* '{FROMGIT (add FROMGITN 1) - '})) - (PSEUDOHOST FROMGIT (CONCAT "{CORE}<" (fetch PROJECTNAME of PROJECT) - ">" - (DATE) + (SETQ FROMGIT (PACK* "{FROMGIT" (add FROMGITN 1) + "}")) + + (* ;; "If both origin/, strip it out of subdirectories") + + (SETQ PRNAME (CL:IF (AND (STRPOS "origin/" BRANCH1 NIL T) + (STRPOS "origin/" BRANCH2 NIL T)) + (SUBSTRING BRANCH2 (CONSTANT (NCHARS "origin/ "))) + BRANCH2)) + (PSEUDOHOST FROMGIT (CONCAT "{DSK}" (fetch PROJECTNAME of PROJECT) + "-PR--" PRNAME "--" (DATE) ">")) - - (* ;; "UNSLASHIT because CORE doesn't know about slash") - (CL:UNLESS DIR1 - (SETQ DIR1 (CONCAT FROMGIT "<" (UNSLASHIT BRANCH1) - ">"))) + (SETQ DIR1 (CONCAT FROMGIT ""))) (CL:UNLESS DIR2 - (SETQ DIR2 (CONCAT FROMGIT "<" (UNSLASHIT BRANCH2) - ">"))) + (SETQ DIR2 (CONCAT FROMGIT ""))) (for D in DIFFS do (SELECTQ (CAR D) (ADDED (* ; @@ -1795,7 +1798,7 @@ (* ;; "For copied files, presumably 2 files are exactly the same. But we hope we can show them on the same line, by virtue of the mapping.") [LET ((GFILE (CDR D)) - F1 F1) + F1 F2) (* ;; "GFILE is a triple (F2 F1 N )") @@ -2434,33 +2437,33 @@ (PUTPROPS GITFNS FILETYPE :TCOMPL) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4187 20766 (GIT-CLONEP 4197 . 5525) (GIT-INIT 5527 . 6157) (GIT-MAKE-PROJECT 6159 . -13824) (GIT-GET-PROJECT 13826 . 15751) (GIT-PUT-PROJECT-FIELD 15753 . 17394) (GIT-PROJECT-PATH 17396 - . 18440) (FIND-ANCESTOR-DIRECTORY 18442 . 18791) (GIT-FIND-CLONE 18793 . 19874) (GIT-MAINBRANCH 19876 - . 20271) (GIT-MAINBRANCH? 20273 . 20764)) (26229 31158 (PRC-COMMAND 26239 . 31156)) (31214 34002 ( -ALLSUBDIRS 31224 . 32510) (MEDLEYSUBDIRS 32512 . 33205) (GITSUBDIRS 33207 . 34000)) (34003 38793 ( -TOGIT 34013 . 35419) (FROMGIT 35421 . 36402) (GIT-DELETE-FILE 36404 . 37250) (MYMEDLEY-DELETE-FILES -37252 . 38791)) (38794 41797 (MYMEDLEYSUBDIR 38804 . 39260) (GITSUBDIR 39262 . 39705) (STRIPDIR 39707 - . 40078) (STRIPHOST 40080 . 40320) (STRIPNAME 40322 . 41075) (STRIPWHERE 41077 . 41795)) (41798 43700 - (GFILE4MFILE 41808 . 42171) (MFILE4GFILE 42173 . 42742) (GIT-REPO-FILENAME 42744 . 43698)) (43749 -54004 (GIT-COMMIT 43759 . 44585) (GIT-PUSH 44587 . 45347) (GIT-PULL 45349 . 46101) (GIT-APPROVAL 46103 - . 46452) (GIT-GET-FILE 46454 . 48369) (GIT-FILE-EXISTS? 48371 . 48645) (GIT-REMOTE-UPDATE 48647 . -49482) (GIT-REMOTE-ADD 49484 . 49791) (GIT-FILE-DATE 49793 . 50840) (GIT-FILE-HISTORY 50842 . 52776) ( -GIT-PRINT-FILE-HISTORY 52778 . 53828) (GIT-FETCH 53830 . 54002)) (54034 65372 (GIT-BRANCH-DIFF 54044 - . 60791) (GIT-COMMIT-DIFFS 60793 . 61684) (GIT-BRANCH-RELATIONS 61686 . 65370)) (65417 84912 ( -GIT-BRANCH-NUM 65427 . 66000) (GIT-CHECKOUT 66002 . 67288) (GIT-WHICH-BRANCH 67290 . 67697) ( -GIT-MAKE-BRANCH 67699 . 70278) (GIT-BRANCHES 70280 . 72875) (GIT-BRANCH-EXISTS? 72877 . 73748) ( -GIT-PICK-BRANCH 73750 . 74240) (GIT-BRANCH-MENU 74242 . 75123) (GIT-BRANCH-WHENSELECTEDFN 75125 . -77664) (GIT-PULL-REQUESTS 77666 . 81293) (GIT-SHORT-BRANCH-NAME 81295 . 81586) (GIT-LONG-NAME 81588 . -81905) (GIT-PRC-BRANCHES 81907 . 84910)) (84942 88390 (GIT-MY-CURRENT-BRANCH 84952 . 85322) ( -GIT-MY-BRANCHP 85324 . 85942) (GIT-MY-NEXT-BRANCH 85944 . 86438) (GIT-MY-BRANCHES 86440 . 88388)) ( -88436 92511 (GIT-ADD-WORKTREE 88446 . 90053) (GIT-REMOVE-WORKTREE 90055 . 90985) (GIT-LIST-WORKTREES -90987 . 91791) (WORKTREEDIR 91793 . 92509)) (92559 125952 (GIT-GET-DIFFERENT-FILES 92569 . 98993) ( -GIT-BRANCHES-COMPARE-DIRECTORIES 98995 . 106226) (GIT-WORKING-COMPARE-DIRECTORIES 106228 . 111935) ( -GIT-COMPARE-WORKTREE 111937 . 115915) (GITCDOBJBUTTONFN 115917 . 120407) (GIT-CD-LABELFN 120409 . -121491) (GIT-CD-MENUFN 121493 . 123933) (GIT-WORKING-COMPARE-FILES 123935 . 124555) ( -GIT-BRANCHES-COMPARE-FILES 124557 . 125721) (GIT-PR-COMPARE 125723 . 125950)) (126022 134345 (CDGITDIR - 126032 . 126719) (GIT-COMMAND 126721 . 128279) (GITORIGIN 128281 . 128978) (GIT-INITIALS 128980 . -129284) (GIT-COMMAND-TO-FILE 129286 . 132771) (GIT-RESULT-TO-LINES 132773 . 133678) (STRIPLOCAL 133680 - . 134343))))) + (FILEMAP (NIL (4206 20785 (GIT-CLONEP 4216 . 5544) (GIT-INIT 5546 . 6176) (GIT-MAKE-PROJECT 6178 . +13843) (GIT-GET-PROJECT 13845 . 15770) (GIT-PUT-PROJECT-FIELD 15772 . 17413) (GIT-PROJECT-PATH 17415 + . 18459) (FIND-ANCESTOR-DIRECTORY 18461 . 18810) (GIT-FIND-CLONE 18812 . 19893) (GIT-MAINBRANCH 19895 + . 20290) (GIT-MAINBRANCH? 20292 . 20783)) (26248 31177 (PRC-COMMAND 26258 . 31175)) (31233 34021 ( +ALLSUBDIRS 31243 . 32529) (MEDLEYSUBDIRS 32531 . 33224) (GITSUBDIRS 33226 . 34019)) (34022 38812 ( +TOGIT 34032 . 35438) (FROMGIT 35440 . 36421) (GIT-DELETE-FILE 36423 . 37269) (MYMEDLEY-DELETE-FILES +37271 . 38810)) (38813 41816 (MYMEDLEYSUBDIR 38823 . 39279) (GITSUBDIR 39281 . 39724) (STRIPDIR 39726 + . 40097) (STRIPHOST 40099 . 40339) (STRIPNAME 40341 . 41094) (STRIPWHERE 41096 . 41814)) (41817 43719 + (GFILE4MFILE 41827 . 42190) (MFILE4GFILE 42192 . 42761) (GIT-REPO-FILENAME 42763 . 43717)) (43768 +54023 (GIT-COMMIT 43778 . 44604) (GIT-PUSH 44606 . 45366) (GIT-PULL 45368 . 46120) (GIT-APPROVAL 46122 + . 46471) (GIT-GET-FILE 46473 . 48388) (GIT-FILE-EXISTS? 48390 . 48664) (GIT-REMOTE-UPDATE 48666 . +49501) (GIT-REMOTE-ADD 49503 . 49810) (GIT-FILE-DATE 49812 . 50859) (GIT-FILE-HISTORY 50861 . 52795) ( +GIT-PRINT-FILE-HISTORY 52797 . 53847) (GIT-FETCH 53849 . 54021)) (54053 65391 (GIT-BRANCH-DIFF 54063 + . 60810) (GIT-COMMIT-DIFFS 60812 . 61703) (GIT-BRANCH-RELATIONS 61705 . 65389)) (65436 84931 ( +GIT-BRANCH-NUM 65446 . 66019) (GIT-CHECKOUT 66021 . 67307) (GIT-WHICH-BRANCH 67309 . 67716) ( +GIT-MAKE-BRANCH 67718 . 70297) (GIT-BRANCHES 70299 . 72894) (GIT-BRANCH-EXISTS? 72896 . 73767) ( +GIT-PICK-BRANCH 73769 . 74259) (GIT-BRANCH-MENU 74261 . 75142) (GIT-BRANCH-WHENSELECTEDFN 75144 . +77683) (GIT-PULL-REQUESTS 77685 . 81312) (GIT-SHORT-BRANCH-NAME 81314 . 81605) (GIT-LONG-NAME 81607 . +81924) (GIT-PRC-BRANCHES 81926 . 84929)) (84961 88409 (GIT-MY-CURRENT-BRANCH 84971 . 85341) ( +GIT-MY-BRANCHP 85343 . 85961) (GIT-MY-NEXT-BRANCH 85963 . 86457) (GIT-MY-BRANCHES 86459 . 88407)) ( +88455 92530 (GIT-ADD-WORKTREE 88465 . 90072) (GIT-REMOVE-WORKTREE 90074 . 91004) (GIT-LIST-WORKTREES +91006 . 91810) (WORKTREEDIR 91812 . 92528)) (92578 126172 (GIT-GET-DIFFERENT-FILES 92588 . 99213) ( +GIT-BRANCHES-COMPARE-DIRECTORIES 99215 . 106446) (GIT-WORKING-COMPARE-DIRECTORIES 106448 . 112155) ( +GIT-COMPARE-WORKTREE 112157 . 116135) (GITCDOBJBUTTONFN 116137 . 120627) (GIT-CD-LABELFN 120629 . +121711) (GIT-CD-MENUFN 121713 . 124153) (GIT-WORKING-COMPARE-FILES 124155 . 124775) ( +GIT-BRANCHES-COMPARE-FILES 124777 . 125941) (GIT-PR-COMPARE 125943 . 126170)) (126242 134565 (CDGITDIR + 126252 . 126939) (GIT-COMMAND 126941 . 128499) (GITORIGIN 128501 . 129198) (GIT-INITIALS 129200 . +129504) (GIT-COMMAND-TO-FILE 129506 . 132991) (GIT-RESULT-TO-LINES 132993 . 133898) (STRIPLOCAL 133900 + . 134563))))) STOP diff --git a/lispusers/GITFNS.LCOM b/lispusers/GITFNS.LCOM index def8564d224b249022c4da7bf3de957b74348f24..5a058265d6c6e1701a5df8fece3e8f1bfa290e12 100644 GIT binary patch delta 1239 zcmZuwOKTHR6z-(0#@I?*3w?lidZB2+Y3JT~C zE~TLDAn2ltf?L6~ZY3+-y6LZQr9VLM+_6cU(7@z=-}%mW?wq;j{@HE+ve*7@x}PyI zUo4AEVk%G;QCUQxyNeSQRT_f;VbU2j7-4Eeq6F59bF0hc(o%6AiqFdH8>10Oq#Q9} zI$}JPHlefvBwk3T;jDdpe4N1i>?WGdt4k#^7P!gnv7D(pgQfxG+;`i$?pGzCvZBfE z8)4L6-_?yiAM6=}NH%BQPh|>u(a;^!wS++-u)7UM9loCv?V2pRsRP}8NxR(l2SXmO z9%$}U*3a?L4*NT)h9J%$3qgoeTr@~{J!L@!1Gxg(oUL0XLK)(@jD?*Wshs<1b*3j= z57=WM{J12z1LYePy(9Ux{dHCNxY~xl>AuC|xjqkG=KO&Nqfbg*oE;8%R6n5~^d*0Q z$6x6)cRj`M3ErCa{{39@Q1?X+z1*qK|5H8kxFc4JH3crzl2xH?Ug#A%En$9v+kPKP zHOnV_i&|5b=PDW9om|+fwjJwM%yNH~hp+JrPFgeexy>C}8y-HlM$IcwSR1)*`FcnE zQQId>;nP&*(UqExu~=*T>Q2q;&T^}3!xdS9q?yJOU{dqADU?AhW5;v{OsV@=IK;Ke>3p-W)DVNgW+T(W4NZ|-G+AwEtYt$+8yixrdD0Kn zXdN0<2|+e*7K}_XlXrk(^?DY*J)d@;!~WK$OkoAtaq3w{zoRMbprj zP2mlbaoBSvA7{i8?wZu?1Y)LQK{IVSh-o+ox?z|GUQhh?As_|&o}HPtz21yeJPwYY zAV7l*$Ygo_4nkE!xIDYDS@ftJ1j54%S5dS%qKL9NQAA8-AX`TM-uC3?av9S?!2poe n_0mFVWr6^&+93Ef$Tk5yNV0Wu_lO(aA8_Bk=smi%`Q7;kUC|)t delta 1166 zcmZuw-D}fO6mMGHW;e%%;Kqh}8W>tIHTUMD9}ZcX+_YWVq$a5o5pk|nhVG-=9+WW( z`s#yQo(KK|;%a>mREp2O_^^M$cYX9h@Fv~LS{F!u=bYa;=XWkS_h2vbdpGiC!F$hK z++E=sq7;WH3o=()e8FKJOMr!pBxD4Ug^k+M+RFO!vsx8u&(}9LXEIQ>RZg`^CB@Vr zS8%zkt(a<_D-p92_~lBm$l2s}g*dJQQ9s2m>7)?{mREt*X$~AIih*Pzkzk>^xJ89d z8AasTc=VcHC=%5sic2)_9W&_(%%vew0wjnc^6oM-LXUJDGG&|GDOeSU(`XItE1ftZ z&hTOeNgiUZghjFSllgHYf>PM~gdPVN!}C72R`K82X&H0`Wso``Le3wB1_aQ&w`=z& zlAzmGi5}Gi9a5mS*JpBh9M@}yYy{?sowlJpnQy~+`n3;u*4%b;4Os<pFwPRhL;mQ!6$l6trXU@_SxG3p@!BcaRjeS#?66-2b@(aeZ$am93s zijyz6fN-}rLdlZ^own?diZ)^8Eysm)H!mfFzvABH=7WYP(zfLS(LfMnu!*UZsEt!p zEw7k4-xhe#NRiNc1SlziqG{BU5$u4(!}ifC(+dY8F9TaK4bxgMgF|WsT?bdmv4ChQ vdyArw26mPr#(~cwgn~et0_9U3ND9DitCmf6W?8SXKjDpi8*bIMzPtYb`