GITFNS: preserves casing of pseudohost prefix-paths of medley projects (#1344)
Also, minor edit to GITFNS.TEDIT, but now also includes a Tedit timestamp.
This commit is contained in:
rmkaplan
GitHub
103
lispusers/GITFNS
103
lispusers/GITFNS
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "23-Sep-2023 13:02:15" {WMEDLEY}<lispusers>GITFNS.;483 124031
|
||||
(FILECREATED " 1-Oct-2023 19:33:26" {WMEDLEY}<lispusers>GITFNS.;489 124166
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS CDGITDIR)
|
||||
:CHANGES-TO (FNS GIT-MAKE-PROJECT)
|
||||
|
||||
:PREVIOUS-DATE "22-Sep-2023 12:08:14" {WMEDLEY}<lispusers>GITFNS.;482)
|
||||
:PREVIOUS-DATE " 1-Oct-2023 19:27:42" {WMEDLEY}<lispusers>GITFNS.;488)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT GITFNSCOMS)
|
||||
@@ -16,7 +16,7 @@
|
||||
(* ;; "Set up")
|
||||
|
||||
(FILES (SYSLOAD FROM LISPUSERS)
|
||||
COMPAREDIRECTORIES COMPARESOURCES COMPARETEXT PSEUDOHOSTS)
|
||||
COMPAREDIRECTORIES COMPARESOURCES COMPARETEXT PSEUDOHOSTS UNIXUTILS)
|
||||
|
||||
(* ;; "")
|
||||
|
||||
@@ -119,7 +119,7 @@
|
||||
|
||||
|
||||
(FILESLOAD (SYSLOAD FROM LISPUSERS)
|
||||
COMPAREDIRECTORIES COMPARESOURCES COMPARETEXT PSEUDOHOSTS)
|
||||
COMPAREDIRECTORIES COMPARESOURCES COMPARETEXT PSEUDOHOSTS UNIXUTILS)
|
||||
|
||||
|
||||
|
||||
@@ -133,15 +133,15 @@
|
||||
(DEFINEQ
|
||||
|
||||
(GIT-CLONEP
|
||||
[LAMBDA (HOST/DIR NOERROR CHECKANCESTORS) (* ; "Edited 12-May-2022 11:44 by rmk")
|
||||
[LAMBDA (HOST/DIR NOERROR CHECKANCESTORS) (* ; "Edited 1-Oct-2023 18:09 by rmk")
|
||||
(* ; "Edited 12-May-2022 11:44 by rmk")
|
||||
(* ; "Edited 8-May-2022 16:24 by rmk")
|
||||
|
||||
(* ;; "If CHECKANCESTORS, looks back up the directory chain to see if perhaps the .git is somewhere higher up.")
|
||||
|
||||
(IF [AND HOST/DIR (LET ((D (SLASHIT (TRUEFILENAME (PACKFILENAME.STRING 'BODY HOST/DIR
|
||||
(IF [AND HOST/DIR (LET [(D (SLASHIT (TRUEFILENAME (PACKFILENAME.STRING 'BODY HOST/DIR
|
||||
'HOST
|
||||
'DSK))
|
||||
T)))
|
||||
'DSK]
|
||||
(IF (DIRECTORYNAMEP (CONCAT D "/.git/"))
|
||||
THEN D
|
||||
ELSEIF (AND CHECKANCESTORS (FIND-ANCESTOR-DIRECTORY
|
||||
@@ -167,6 +167,7 @@
|
||||
|
||||
(GIT-MAKE-PROJECT
|
||||
[LAMBDA (PROJECTNAME CLONEPATH WORKINGPATH EXCLUSIONS DEFAULTSUBDIRS)
|
||||
(* ; "Edited 1-Oct-2023 19:33 by rmk")
|
||||
(* ; "Edited 30-Mar-2023 09:06 by rmk")
|
||||
(* ; "Edited 5-Feb-2023 12:43 by rmk")
|
||||
(* ; "Edited 1-Feb-2023 16:55 by rmk")
|
||||
@@ -208,7 +209,7 @@
|
||||
(GIT-CLONEP (MEDLEYDIR (L-CASE PROJECTNAME)
|
||||
NIL NIL T)
|
||||
T)
|
||||
(GIT-CLONEP (MEDLEYDIR (CONCAT "../" PROJECTNAME)
|
||||
(GIT-CLONEP (MEDLEYDIR (CONCAT "../" (L-CASE PROJECTNAME))
|
||||
NIL NIL T)
|
||||
T)
|
||||
(GIT-CLONEP (DIRECTORYNAME (CONCAT MEDLEYDIR "../git-" (L-CASE
|
||||
@@ -219,12 +220,11 @@
|
||||
(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
|
||||
elseif (GIT-CLONEP [SLASHIT (PACKFILENAME 'HOST 'DSK 'DIRECTORY
|
||||
(UNPACKFILENAME.STRING (TRUEFILENAME
|
||||
CLONEPATH)
|
||||
'DIRECTORY
|
||||
'RETURN))
|
||||
T)
|
||||
'RETURN]
|
||||
T T)
|
||||
else (ERROR (CONCAT "Can't find the clone directory " CLONEPATH " for "
|
||||
PROJECTNAME]
|
||||
@@ -265,7 +265,7 @@
|
||||
(DIRECTORYNAME (TRUEFILENAME WORKINGPATH)
|
||||
T)))
|
||||
[SETQ WORKINGPATH (if WP
|
||||
then (UNSLASHIT WP T)
|
||||
then (UNSLASHIT WP)
|
||||
elseif WORKINGPATH
|
||||
then (ERROR (CONCAT "Can't find the working directory "
|
||||
(AND (EQ WORKINGPATH T)
|
||||
@@ -1720,7 +1720,8 @@
|
||||
(LIST DIR1 DIR2 MAPPINGS))])
|
||||
|
||||
(GIT-BRANCHES-COMPARE-DIRECTORIES
|
||||
[LAMBDA (BRANCH1 BRANCH2 LOCAL PROJECT) (* ; "Edited 10-Jun-2023 17:28 by rmk")
|
||||
[LAMBDA (BRANCH1 BRANCH2 LOCAL PROJECT) (* ; "Edited 26-Sep-2023 22:40 by rmk")
|
||||
(* ; "Edited 10-Jun-2023 17:28 by rmk")
|
||||
(* ; "Edited 12-Sep-2022 14:41 by rmk")
|
||||
(* ; "Edited 20-Jul-2022 21:18 by rmk")
|
||||
(* ; "Edited 22-May-2022 22:47 by rmk")
|
||||
@@ -1791,10 +1792,9 @@
|
||||
(TERPRI T)
|
||||
(IF (FETCH (CDVALUE CDENTRIES) OF CDVALUE)
|
||||
THEN (SETQ LAST-BRANCH-CDVALUE CDVALUE)
|
||||
(CDBROWSER CDVALUE (CONCAT "Comparing " (L-CASE (FETCH PROJECTNAME
|
||||
OF PROJECT)
|
||||
T)
|
||||
" " SHORT1 " and " SHORT2 " "
|
||||
(CDBROWSER CDVALUE (CONCAT (L-CASE (FETCH PROJECTNAME OF PROJECT)
|
||||
T)
|
||||
" " SHORT1 " vs " SHORT2 " "
|
||||
(LENGTH (FETCH (CDVALUE CDENTRIES) OF CDVALUE))
|
||||
" files")
|
||||
(LIST SHORT1 SHORT2)
|
||||
@@ -1812,6 +1812,8 @@
|
||||
(GIT-WORKING-COMPARE-DIRECTORIES
|
||||
[LAMBDA (SUBDIRS SELECT EXCLUDEDFILES FIXDIRECTORYDATES UPDATE PROJECT)
|
||||
|
||||
(* ;; "Edited 26-Sep-2023 22:41 by rmk")
|
||||
|
||||
(* ;; "Edited 17-Jun-2023 22:54 by rmk")
|
||||
|
||||
(* ;; "Edited 10-Jun-2023 21:32 by rmk")
|
||||
@@ -1880,9 +1882,8 @@
|
||||
(SETQ $$VAL (CDMERGE $$VAL))
|
||||
[SETQ SUBDIRS (CONCATLIST (FOR SUBDIR IN SUBDIRS COLLECT (CONCAT SUBDIR " "])
|
||||
[FOR CDVAL TITLE IN $$VAL AS SUBDIR INSIDE SUBDIRS
|
||||
DO (SETQ TITLE (CONCAT "Comparing " WPROJ " and " BRANCH2 " " SUBDIR
|
||||
" " (LENGTH (fetch (CDVALUE CDENTRIES)
|
||||
of CDVAL))
|
||||
DO (SETQ TITLE (CONCAT WPROJ " vs. " BRANCH2 " " SUBDIR " "
|
||||
(LENGTH (fetch (CDVALUE CDENTRIES) of CDVAL))
|
||||
" files"))
|
||||
[CDBROWSER CDVAL TITLE `(,WPROJ ,BRANCH2)
|
||||
`(BRANCH1 ,WPROJ BRANCH2 ,BRANCH2 SUBDIR ,SUBDIR LABELFN
|
||||
@@ -2299,33 +2300,33 @@
|
||||
|
||||
(PUTPROPS GITFNS FILETYPE :TCOMPL)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4053 20503 (GIT-CLONEP 4063 . 5326) (GIT-INIT 5328 . 5958) (GIT-MAKE-PROJECT 5960 .
|
||||
13561) (GIT-GET-PROJECT 13563 . 15488) (GIT-PUT-PROJECT-FIELD 15490 . 17131) (GIT-PROJECT-PATH 17133
|
||||
. 18177) (FIND-ANCESTOR-DIRECTORY 18179 . 18528) (GIT-FIND-CLONE 18530 . 19611) (GIT-MAINBRANCH 19613
|
||||
. 20008) (GIT-MAINBRANCH? 20010 . 20501)) (25911 28038 (PRC-COMMAND 25921 . 28036)) (28094 30882 (
|
||||
ALLSUBDIRS 28104 . 29390) (MEDLEYSUBDIRS 29392 . 30085) (GITSUBDIRS 30087 . 30880)) (30883 35673 (
|
||||
TOGIT 30893 . 32299) (FROMGIT 32301 . 33282) (GIT-DELETE-FILE 33284 . 34130) (MYMEDLEY-DELETE-FILES
|
||||
34132 . 35671)) (35674 38677 (MYMEDLEYSUBDIR 35684 . 36140) (GITSUBDIR 36142 . 36585) (STRIPDIR 36587
|
||||
. 36958) (STRIPHOST 36960 . 37200) (STRIPNAME 37202 . 37955) (STRIPWHERE 37957 . 38675)) (38678 40580
|
||||
(GFILE4MFILE 38688 . 39051) (MFILE4GFILE 39053 . 39622) (GIT-REPO-FILENAME 39624 . 40578)) (40629
|
||||
52459 (GIT-COMMIT 40639 . 41465) (GIT-PUSH 41467 . 42111) (GIT-PULL 42113 . 42725) (GIT-APPROVAL 42727
|
||||
. 43076) (GIT-GET-FILE 43078 . 45043) (GIT-FILE-EXISTS? 45045 . 45319) (GIT-REMOTE-UPDATE 45321 .
|
||||
46045) (GIT-REMOTE-ADD 46047 . 46354) (GIT-FILE-DATE 46356 . 47287) (GIT-FILE-HISTORY 47289 . 49223) (
|
||||
GIT-PRINT-FILE-HISTORY 49225 . 50275) (GIT-FETCH 50277 . 50449) (GIT-PR-BRANCHES 50451 . 52457)) (
|
||||
52489 63082 (GIT-BRANCH-DIFF 52499 . 58839) (GIT-COMMIT-DIFFS 58841 . 59394) (GIT-BRANCH-RELATIONS
|
||||
59396 . 63080)) (63127 76230 (GIT-BRANCH-NUM 63137 . 63710) (GIT-CHECKOUT 63712 . 64771) (
|
||||
GIT-WHICH-BRANCH 64773 . 65071) (GIT-MAKE-BRANCH 65073 . 67286) (GIT-BRANCHES 67288 . 69556) (
|
||||
GIT-BRANCH-EXISTS? 69558 . 70262) (GIT-PICK-BRANCH 70264 . 70754) (GIT-BRANCH-MENU 70756 . 71459) (
|
||||
GIT-PULL-REQUESTS 71461 . 73607) (GIT-SHORT-BRANCH-NAME 73609 . 73900) (GIT-LONG-NAME 73902 . 74219) (
|
||||
GIT-PRC-BRANCHES 74221 . 76228)) (76260 79595 (GIT-MY-CURRENT-BRANCH 76270 . 76640) (GIT-MY-BRANCHP
|
||||
76642 . 77147) (GIT-MY-NEXT-BRANCH 77149 . 77643) (GIT-MY-BRANCHES 77645 . 79593)) (79641 83593 (
|
||||
GIT-ADD-WORKTREE 79651 . 81135) (GIT-REMOVE-WORKTREE 81137 . 82067) (GIT-LIST-WORKTREES 82069 . 82873)
|
||||
(WORKTREEDIR 82875 . 83591)) (83641 115865 (GIT-GET-DIFFERENT-FILES 83651 . 90075) (
|
||||
GIT-BRANCHES-COMPARE-DIRECTORIES 90077 . 96422) (GIT-WORKING-COMPARE-DIRECTORIES 96424 . 101848) (
|
||||
GIT-COMPARE-WORKTREE 101850 . 105828) (GITCDOBJBUTTONFN 105830 . 110320) (GIT-CD-LABELFN 110322 .
|
||||
111404) (GIT-CD-MENUFN 111406 . 113846) (GIT-WORKING-COMPARE-FILES 113848 . 114468) (
|
||||
GIT-BRANCHES-COMPARE-FILES 114470 . 115634) (GIT-PR-COMPARE 115636 . 115863)) (115935 123964 (CDGITDIR
|
||||
115945 . 116632) (GIT-COMMAND 116634 . 118192) (GITORIGIN 118194 . 118891) (GIT-INITIALS 118893 .
|
||||
119197) (GIT-COMMAND-TO-FILE 119199 . 122688) (GIT-RESULT-TO-LINES 122690 . 123297) (STRIPLOCAL 123299
|
||||
. 123962)))))
|
||||
(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)))))
|
||||
STOP
|
||||
|
||||
Reference in New Issue
Block a user