Skip to content

GITFNS: preserves casing of pseudohost prefix-paths of medley projects #1344

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.

Sign up for GitHub

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

Merged
masinter merged 1 commit into from
Oct 16, 2023
Merged

GITFNS: preserves casing of pseudohost prefix-paths of medley projects #1344

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
103 changes: 52 additions & 51 deletions lispusers/GITFNS
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -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)
Expand All @@ -16,7 +16,7 @@
(* ;; "Set up")

(FILES (SYSLOAD FROM LISPUSERS)
Copy link
Member

@masinter masinter Oct 13, 2023

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I've taken to changing these to just (FILES file1 file2 ..) rather than (FILES (SYSLOAD FROM wherever) fiile1 file2 ..) with the idea that LDFLG is inherited and DIRECTORIES should be set up. Let's discuss.s

COMPAREDIRECTORIES COMPARESOURCES COMPARETEXT PSEUDOHOSTS)
COMPAREDIRECTORIES COMPARESOURCES COMPARETEXT PSEUDOHOSTS UNIXUTILS)

(* ;; "")

Expand Down Expand Up @@ -119,7 +119,7 @@


(FILESLOAD (SYSLOAD FROM LISPUSERS)
COMPAREDIRECTORIES COMPARESOURCES COMPARETEXT PSEUDOHOSTS)
COMPAREDIRECTORIES COMPARESOURCES COMPARETEXT PSEUDOHOSTS UNIXUTILS)



Expand All @@ -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
Expand All @@ -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")
Expand Down Expand Up @@ -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
Expand All @@ -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]
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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")
Expand Down Expand Up @@ -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)
Expand All @@ -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")
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Binary file modified lispusers/GITFNS.LCOM
View file
Open in desktop
Binary file not shown.
Loading