GITFNS translates underscore in /tmp/ filenames
This commit is contained in:
rmkaplan
212
lispusers/GITFNS
212
lispusers/GITFNS
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "22-Sep-2025 12:52:41" {WMEDLEY}<lispusers>GITFNS.;550 134632
|
||||
(FILECREATED "23-Sep-2025 21:43:21" {WMEDLEY}<lispusers>GITFNS.;551 134847
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS GIT-GET-FILE GIT-GET-DIFFERENT-FILES)
|
||||
:CHANGES-TO (FNS GIT-GET-DIFFERENT-FILES)
|
||||
|
||||
:PREVIOUS-DATE " 9-May-2025 11:39:55" {WMEDLEY}<lispusers>GITFNS.;545)
|
||||
:PREVIOUS-DATE "22-Sep-2025 12:52:41" {WMEDLEY}<lispusers>GITFNS.;550)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT GITFNSCOMS)
|
||||
@@ -1733,6 +1733,8 @@
|
||||
[LAMBDA (BRANCH1 BRANCH2 DIR1 DIR2 PROJECT)
|
||||
(DECLARE (USEDFREE FROMGITN))
|
||||
|
||||
(* ;; "Edited 23-Sep-2025 21:42 by rmk")
|
||||
|
||||
(* ;; "Edited 22-Sep-2025 12:48 by rmk")
|
||||
|
||||
(* ;; "Edited 12-Sep-2022 14:58 by rmk")
|
||||
@@ -1746,98 +1748,98 @@
|
||||
(SETQ PROJECT (GIT-GET-PROJECT PROJECT))
|
||||
(SETQ BRANCH1 (GIT-BRANCH-EXISTS? BRANCH1 NIL PROJECT))
|
||||
(SETQ BRANCH2 (GIT-BRANCH-EXISTS? BRANCH2 NIL PROJECT))
|
||||
(LET
|
||||
(MAPPINGS FROMGIT FROMGITDIR PRNAME (DIFFS (GIT-BRANCH-DIFF BRANCH1 BRANCH2 PROJECT)))
|
||||
(CL:WHEN DIFFS
|
||||
(SETQ FROMGIT (PACK* "{FROMGIT" (add FROMGITN 1)
|
||||
"}"))
|
||||
(LET (MAPPINGS FROMGIT FROMGITDIR PRNAME (DIFFS (GIT-BRANCH-DIFF BRANCH1 BRANCH2 PROJECT)))
|
||||
(CL:WHEN DIFFS
|
||||
(SETQ FROMGIT (PACK* "{FROMGIT" (add FROMGITN 1)
|
||||
"}"))
|
||||
|
||||
(* ;; "If both origin/, strip it out of subdirectories")
|
||||
(* ;; "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}<tmp>" (fetch PROJECTNAME of PROJECT)
|
||||
"-PR--" PRNAME "--" (DATE)
|
||||
">"))
|
||||
(CL:UNLESS DIR1
|
||||
(SETQ DIR1 (CONCAT FROMGIT "<master>")))
|
||||
(CL:UNLESS DIR2
|
||||
(SETQ DIR2 (CONCAT FROMGIT "<pr>")))
|
||||
(for D in DIFFS
|
||||
do (SELECTQ (CAR D)
|
||||
(ADDED (* ;
|
||||
(SETQ PRNAME (MTOUSTRING (CL:IF (AND (STRPOS "origin/" BRANCH1 NIL T)
|
||||
(STRPOS "origin/" BRANCH2 NIL T))
|
||||
(SUBSTRING BRANCH2 (CONSTANT (NCHARS "origin/ ")))
|
||||
BRANCH2)))
|
||||
(PSEUDOHOST FROMGIT (CONCAT "{DSK}<tmp>" (fetch PROJECTNAME of PROJECT)
|
||||
"-PR--" PRNAME "--" (DATE)
|
||||
">"))
|
||||
(CL:UNLESS DIR1
|
||||
(SETQ DIR1 (CONCAT FROMGIT "<master>")))
|
||||
(CL:UNLESS DIR2
|
||||
(SETQ DIR2 (CONCAT FROMGIT "<pr>")))
|
||||
(for D in DIFFS
|
||||
do
|
||||
(SELECTQ (CAR D)
|
||||
(ADDED (* ;
|
||||
"Shouldn't exist in BRANCH2, should exist in BRANCH1, but maybe ADDED and DELETED are mixed up?")
|
||||
(SETQ D (CADR D))
|
||||
(OR (GIT-GET-FILE BRANCH1 D (CONCAT DIR1 D)
|
||||
T PROJECT)
|
||||
(GIT-GET-FILE BRANCH2 D (CONCAT DIR2 D)
|
||||
T PROJECT)))
|
||||
(DELETED
|
||||
(* ;; "Shouldn't exist in BRANCH1, should exist in BRANCH2. But maybe git is just confused in marking a file that exists in the wrong place as a delete instead of an add, or maybe it may think of a file that doesn't exist at all as having been deleted. Try for both, but don't cause an error.")
|
||||
(SETQ D (CADR D))
|
||||
(OR (GIT-GET-FILE BRANCH1 D (CONCAT DIR1 D)
|
||||
T PROJECT)
|
||||
(GIT-GET-FILE BRANCH2 D (CONCAT DIR2 D)
|
||||
T PROJECT)))
|
||||
(DELETED
|
||||
(* ;; "Shouldn't exist in BRANCH1, should exist in BRANCH2. But maybe git is just confused in marking a file that exists in the wrong place as a delete instead of an add, or maybe it may think of a file that doesn't exist at all as having been deleted. Try for both, but don't cause an error.")
|
||||
|
||||
(SETQ D (CADR D))
|
||||
(OR (GIT-GET-FILE BRANCH2 D (CONCAT DIR2 D)
|
||||
T PROJECT)
|
||||
(GIT-GET-FILE BRANCH1 D (CONCAT DIR1 D)
|
||||
T PROJECT)))
|
||||
(CHANGED (* ; "Should exist in both branches")
|
||||
(SETQ D (CADR D))
|
||||
(GIT-GET-FILE BRANCH1 D (CONCAT DIR1 D)
|
||||
T PROJECT)
|
||||
(GIT-GET-FILE BRANCH2 D (CONCAT DIR2 D)
|
||||
T PROJECT))
|
||||
((RENAMED COPIED)
|
||||
(SETQ D (CADR D))
|
||||
(OR (GIT-GET-FILE BRANCH2 D (CONCAT DIR2 D)
|
||||
T PROJECT)
|
||||
(GIT-GET-FILE BRANCH1 D (CONCAT DIR1 D)
|
||||
T PROJECT)))
|
||||
(CHANGED (* ; "Should exist in both branches")
|
||||
(SETQ D (CADR D))
|
||||
(GIT-GET-FILE BRANCH1 D (CONCAT DIR1 D)
|
||||
T PROJECT)
|
||||
(GIT-GET-FILE BRANCH2 D (CONCAT DIR2 D)
|
||||
T PROJECT))
|
||||
((RENAMED COPIED)
|
||||
|
||||
(* ;; "These entries are from-to filename pairs. If (CADDR) is 100, only need to fetch one, because it presumably has disappeared in BRANCH2 and reappeared in BRANCH1. MAPPINGS is returned so the connection can be reestablished higher up. ")
|
||||
|
||||
|
||||
(* ;; "If renamed and then changed, for now treat as unrelated adds and deletes: put both files in the fromgit directory. Perhaps the mapping should still figure out how to relate them.")
|
||||
|
||||
(* ;; "If renamed and then changed, for now treat as unrelated adds and deletes: put both files in the fromgit directory. Perhaps the mapping should still figure out how to relate them.")
|
||||
|
||||
(* ;; "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.")
|
||||
(* ;; "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 F2)
|
||||
[LET ((GFILE (CDR D))
|
||||
F1 F2)
|
||||
|
||||
(* ;; "GFILE is a triple (F2 F1 N )")
|
||||
(* ;; "GFILE is a triple (F2 F1 N )")
|
||||
|
||||
(* ;; "F1 is the file in branch 1, if any, F2 is in branch 2")
|
||||
(* ;; "F1 is the file in branch 1, if any, F2 is in branch 2")
|
||||
|
||||
(SETQ F1 (GIT-GET-FILE BRANCH1 (CADR GFILE)
|
||||
(CONCAT DIR1 (CADR GFILE))
|
||||
T PROJECT))
|
||||
(SETQ F2 (GIT-GET-FILE BRANCH2 (CADR GFILE)
|
||||
(CONCAT DIR2 (CADR GFILE))
|
||||
T PROJECT))
|
||||
(SETQ F1 (GIT-GET-FILE BRANCH1 (CADR GFILE)
|
||||
(CONCAT DIR1 (CADR GFILE))
|
||||
T PROJECT))
|
||||
(SETQ F2 (GIT-GET-FILE BRANCH2 (CADR GFILE)
|
||||
(CONCAT DIR2 (CADR GFILE))
|
||||
T PROJECT))
|
||||
|
||||
(* ;; "Let the directories figure it out")
|
||||
(* ;; "Let the directories figure it out")
|
||||
|
||||
(AND NIL (if (EQ (CADDR GFILE)
|
||||
100)
|
||||
then
|
||||
(AND NIL (if (EQ (CADDR GFILE)
|
||||
100)
|
||||
then
|
||||
|
||||
(* ;; "A little tricky to figure out what corresponds to the real file in the mapping, which directory it belongs to. Maybe the first one should always be one that exists, the second may just be a useful name. But we have to know whether to match against INFO1 or INFO2")
|
||||
|
||||
(HELP GFILE 100)
|
||||
(push MAPPINGS
|
||||
(LIST (LIST)
|
||||
(FULLNAME F1)
|
||||
(SLASHIT (U-CASE (CONCAT DIR2 (CAR GFILE))
|
||||
)
|
||||
T)
|
||||
(NTHCHAR (CAR D)
|
||||
1)
|
||||
100))
|
||||
else
|
||||
(* ;;
|
||||
(HELP GFILE 100)
|
||||
(push MAPPINGS
|
||||
(LIST (LIST)
|
||||
(FULLNAME F1)
|
||||
(SLASHIT (U-CASE (CONCAT DIR2
|
||||
(CAR GFILE)))
|
||||
T)
|
||||
(NTHCHAR (CAR D)
|
||||
1)
|
||||
100))
|
||||
else
|
||||
(* ;;
|
||||
"If not a perfect match, then the directory should figure it out")
|
||||
|
||||
(GIT-GET-FILE BRANCH2 (CAR GFILE)
|
||||
(CONCAT DIR2 (CAR GFILE))
|
||||
T PROJECT])
|
||||
(HELP "UNKNOWN GIT-DIFF TAG" D)))
|
||||
(LIST DIR1 DIR2 MAPPINGS))])
|
||||
(GIT-GET-FILE BRANCH2 (CAR GFILE)
|
||||
(CONCAT DIR2 (CAR GFILE))
|
||||
T PROJECT])
|
||||
(HELP "UNKNOWN GIT-DIFF TAG" D)))
|
||||
(LIST DIR1 DIR2 MAPPINGS))])
|
||||
|
||||
(GIT-BRANCHES-COMPARE-DIRECTORIES
|
||||
[LAMBDA (BRANCH1 BRANCH2 LOCAL PROJECT) (* ; "Edited 12-Jun-2024 22:52 by mth")
|
||||
@@ -2437,33 +2439,33 @@
|
||||
|
||||
(PUTPROPS GITFNS FILETYPE :TCOMPL)
|
||||
(DECLARE%: DONTCOPY
|
||||
(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)))))
|
||||
(FILEMAP (NIL (4193 20772 (GIT-CLONEP 4203 . 5531) (GIT-INIT 5533 . 6163) (GIT-MAKE-PROJECT 6165 .
|
||||
13830) (GIT-GET-PROJECT 13832 . 15757) (GIT-PUT-PROJECT-FIELD 15759 . 17400) (GIT-PROJECT-PATH 17402
|
||||
. 18446) (FIND-ANCESTOR-DIRECTORY 18448 . 18797) (GIT-FIND-CLONE 18799 . 19880) (GIT-MAINBRANCH 19882
|
||||
. 20277) (GIT-MAINBRANCH? 20279 . 20770)) (26235 31164 (PRC-COMMAND 26245 . 31162)) (31220 34008 (
|
||||
ALLSUBDIRS 31230 . 32516) (MEDLEYSUBDIRS 32518 . 33211) (GITSUBDIRS 33213 . 34006)) (34009 38799 (
|
||||
TOGIT 34019 . 35425) (FROMGIT 35427 . 36408) (GIT-DELETE-FILE 36410 . 37256) (MYMEDLEY-DELETE-FILES
|
||||
37258 . 38797)) (38800 41803 (MYMEDLEYSUBDIR 38810 . 39266) (GITSUBDIR 39268 . 39711) (STRIPDIR 39713
|
||||
. 40084) (STRIPHOST 40086 . 40326) (STRIPNAME 40328 . 41081) (STRIPWHERE 41083 . 41801)) (41804 43706
|
||||
(GFILE4MFILE 41814 . 42177) (MFILE4GFILE 42179 . 42748) (GIT-REPO-FILENAME 42750 . 43704)) (43755
|
||||
54010 (GIT-COMMIT 43765 . 44591) (GIT-PUSH 44593 . 45353) (GIT-PULL 45355 . 46107) (GIT-APPROVAL 46109
|
||||
. 46458) (GIT-GET-FILE 46460 . 48375) (GIT-FILE-EXISTS? 48377 . 48651) (GIT-REMOTE-UPDATE 48653 .
|
||||
49488) (GIT-REMOTE-ADD 49490 . 49797) (GIT-FILE-DATE 49799 . 50846) (GIT-FILE-HISTORY 50848 . 52782) (
|
||||
GIT-PRINT-FILE-HISTORY 52784 . 53834) (GIT-FETCH 53836 . 54008)) (54040 65378 (GIT-BRANCH-DIFF 54050
|
||||
. 60797) (GIT-COMMIT-DIFFS 60799 . 61690) (GIT-BRANCH-RELATIONS 61692 . 65376)) (65423 84918 (
|
||||
GIT-BRANCH-NUM 65433 . 66006) (GIT-CHECKOUT 66008 . 67294) (GIT-WHICH-BRANCH 67296 . 67703) (
|
||||
GIT-MAKE-BRANCH 67705 . 70284) (GIT-BRANCHES 70286 . 72881) (GIT-BRANCH-EXISTS? 72883 . 73754) (
|
||||
GIT-PICK-BRANCH 73756 . 74246) (GIT-BRANCH-MENU 74248 . 75129) (GIT-BRANCH-WHENSELECTEDFN 75131 .
|
||||
77670) (GIT-PULL-REQUESTS 77672 . 81299) (GIT-SHORT-BRANCH-NAME 81301 . 81592) (GIT-LONG-NAME 81594 .
|
||||
81911) (GIT-PRC-BRANCHES 81913 . 84916)) (84948 88396 (GIT-MY-CURRENT-BRANCH 84958 . 85328) (
|
||||
GIT-MY-BRANCHP 85330 . 85948) (GIT-MY-NEXT-BRANCH 85950 . 86444) (GIT-MY-BRANCHES 86446 . 88394)) (
|
||||
88442 92517 (GIT-ADD-WORKTREE 88452 . 90059) (GIT-REMOVE-WORKTREE 90061 . 90991) (GIT-LIST-WORKTREES
|
||||
90993 . 91797) (WORKTREEDIR 91799 . 92515)) (92565 126387 (GIT-GET-DIFFERENT-FILES 92575 . 99428) (
|
||||
GIT-BRANCHES-COMPARE-DIRECTORIES 99430 . 106661) (GIT-WORKING-COMPARE-DIRECTORIES 106663 . 112370) (
|
||||
GIT-COMPARE-WORKTREE 112372 . 116350) (GITCDOBJBUTTONFN 116352 . 120842) (GIT-CD-LABELFN 120844 .
|
||||
121926) (GIT-CD-MENUFN 121928 . 124368) (GIT-WORKING-COMPARE-FILES 124370 . 124990) (
|
||||
GIT-BRANCHES-COMPARE-FILES 124992 . 126156) (GIT-PR-COMPARE 126158 . 126385)) (126457 134780 (CDGITDIR
|
||||
126467 . 127154) (GIT-COMMAND 127156 . 128714) (GITORIGIN 128716 . 129413) (GIT-INITIALS 129415 .
|
||||
129719) (GIT-COMMAND-TO-FILE 129721 . 133206) (GIT-RESULT-TO-LINES 133208 . 134113) (STRIPLOCAL 134115
|
||||
. 134778)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user